Produced by Araxis Merge on 11/9/2018 12:33:46 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHGENXML.m | Mon Nov 5 16:42:11 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHGENXML.m | Fri Nov 9 01:18:34 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 2666 |
Changed | 1 | 2 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | CHGENXML ; HAC/DLB; C LAIM DATA EXTRACTION IN .XML F ORMAT | |
2 | ;;1.0;;CH AMPVA SYST EM;JULY 4, 1990;Buil d 10 | |
3 | ;EPMO TRA INING EFFO RT-Begin 1 /1/2017;;; ;;Build 1 | |
4 | ; ATTEMPT ED TO USE THE NATION AL TEAM NO DE EXTRACT ION, BUT I NCONSISTEN CIES | |
5 | ; (ESPECI ALLY RELAT ED TO NODE ENTRY COU NT ENTRY) CAUSED THE CODE TO E XIT | |
6 | ; EARLY. I CREATED A FUNCTION THAT USE $O IN LIEW OF THE NO DE ENTRY C OUNTS | |
7 | ; TO ENSU RE THAT AL L ENTRIES WOULD BE E XTRACTED. | |
8 | ||
9 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
10 | ; GENXML USES THE P DI VALUE F ROM THE IN PUT SCREEN AND MAKES THE CALLS TO | |
11 | ; THE BUF FER FILE E XTRACTION FUNCTIONS, WHICH IN TURN CONTR OL THE DAT A TO | |
12 | ; BE WRIT TEN TO THE XML FILE. | |
13 | ; EACH BU FFER FUNCT ION DETERM INES THE D ATA TO BE OUTPUT FOR THAT CLAI M BUFFER. | |
14 | ; EVERY A TTEMPT HAS BEEN MADE TO SIMPLI FY THE PRO CESS, UTIL IZING A | |
15 | ; COMMON SET OF FUN CTIONS TO PERFORM TH E DATA EXT RACTION AN D WRITING OF | |
16 | ; THE DAT A TO THE X ML FILE. | |
17 | ; THIS FU NCTION CUR RENTLY SUP PORTS THE EXTRACTION FOR THE C LAIM | |
18 | ; BUFFERS (^CHMXCL- >^CHMXCLF) , THE IMAG E BUFFERS (^CHMIMAGE , ^CHMIMG) , | |
19 | ; THE PAY MENT AND W ORK BUFFER S (^CHMPAY , ^CHMPAYW ) AND THE ^CHMEDI | |
20 | ; BUFFER. IT ALSO C ONTAINS BO TH DOCUMEN TED AND UN DOCUMENTED CROSS- | |
21 | ; REFEREN CES FOR CL AIM LOOKUP AND DEBUG . | |
22 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
23 | ; | |
24 | GENXML(PDI ,USER) | |
25 | ; ID TH E IDENTIFY ING PDI | |
26 | ; USER TH E USER REQ UESTING TH E XML FILE (USED IN DIRECTORY PATH FOR X ML FILE) | |
27 | N STYPE,P CN,CLI,IDX STR,AI,BI, CI,EI,FI,P AYI,EDII,L N,VERBOSE | |
28 | N MNODE ; MN ODE IS A P LACE TO ST ORE THE "M ULTIPLE" N ODE ADDRES S | |
29 | S (AI,BI, CI,EI,FI,P AYI,EDII)= 0 | |
30 | S VERBOSE =1 | |
31 | S X=220 X ^%ZOSF("R M") ; SET THE CACHE DISP LAY TO 220 CHARACTER S WIDE | |
32 | U 0 W:VER BOSE !,"CA LLING FORM AT: >D GEN XML^CHGENX ML(PDI,USE RNAME)" | |
33 | U 0 W:VER BOSE !,"EX AMPLE CALL : >D GENXM L^CHGENXML (201503091 040364,"" DNS XXXXX"")" | |
34 | U 0 W:VER BOSE !,"TH IS APP EXT RACTS CLAI M INFORMAT ION TO AN ""XML"" FI LE IN ORDE R TO" | |
35 | U 0 W:VER BOSE !,"MO VE THE INF ORMATION I NTO A NEW SET OF NOD ES, OR MOV E TO ANOTH ER ENVIRON MENT." | |
36 | U 0 W:VER BOSE !,"TH E PDI IDEN TIFIES THE CLAIM FOR EXTRACTIO N, AND THE USERID ID ENTIFIES" | |
37 | U 0 W:VER BOSE !,"TH E TARGET D IRECTORY F OR THE XML FILE. THE XML FILEN AME IS BAS ED ON THE" | |
38 | U 0 W:VER BOSE !,"PD I. EXAMPLE : IMG_2015 0309104036 4.XML" | |
39 | I '$D(PDI ) D Q | |
40 | .U 0 W:VE RBOSE !,"Y OU MUST PR OVIDE THE PDI" | |
41 | I $D(^CHM XCLE("PDI" ,PDI)) D ; IF SUC CESSFUL IN DETERMINI NG THE PDI , BEGIN CL AIM BUFFER EXTRACTIO N | |
42 | .S PCN=0, PCN=$O(^CH MXCLE("PDI ",PDI,PCN) ) | |
43 | .S CLI=0, CLI=$O(^CH MXCLE("PDI ",PDI,PCN, CLI)) ; IN DEX INTO ^ CHMXCL() | |
44 | .S IDXSTR =0,IDXSTR= $O(^CHMXCL E("PDI",PD I,PCN,CLI, IDXSTR)) | |
45 | I 'IDXSTR W !,"INVA LID INDEX STRING." Q | |
46 | S AI=$P(I DXSTR,"*", 1) ; TRANSACT ION BUFFER (^CHMXCLA ()) | |
47 | S BI=$P(I DXSTR,"*", 2) ; PROVIDER BUFFER (^ CHMXCLB()) | |
48 | S CI=$P(I DXSTR,"*", 3) ; PATIENT BUFFER (^C HMXCLC()) | |
49 | S EI=$P(I DXSTR,"*", 4) ; CLAIM BU FFER (^CHM XCLE()) | |
50 | S FI=0,FI =$O(^CHMXC LF("B",EI, FI)) ; LINE B UFFER (^CH MXCLF()) | |
51 | U 0 W:VER BOSE !,"PD I ("_PDI_" ) TYPE IS "_$$GETPDI TYP(PDI) | |
52 | U 0 W:VER BOSE !,?10 ,"RAW CLAI M BUFFER I NDEX VALUE (S)" | |
53 | S LN="-" F XN=2:1:8 0 S LN=LN_ "-" ; LINE S EPARATOR, CREATE LIN E | |
54 | U 0 W:VER BOSE !,LN | |
55 | U 0 W:VER BOSE !,"FI LE BUFFER CHMXC L(",CLI,?5 0,$S($D(^C HMXCL(CLI) )=0:"UNAVA ILABLE",1: "") | |
56 | U 0 W:VER BOSE !,"TR ANSACTION BUF CHMXC LA(",AI,?5 0,$S($D(^C HMXCLA(AI) )=0:"UNAVA ILABLE",1: "") | |
57 | U 0 W:VER BOSE !,"PR OVIDER BUF FER CHMXC LB(",BI,?5 0,$S($D(^C HMXCLB(BI) )=0:"UNAVA ILABLE",1: "") | |
58 | U 0 W:VER BOSE !,"PA TIENT BUFF ER CHMXC LC(",CI,?5 0,$S($D(^C HMXCLC(CI) )=0:"UNAVA ILABLE",1: "") | |
59 | U 0 W:VER BOSE !,"CL AIM BUFFER CHMXC LE(",EI,?5 0,$S($D(^C HMXCLE(EI) )=0:"UNAVA ILABLE",1: "") | |
60 | I EI D | |
61 | .S (FI,VE NI)=0 | |
62 | .F CNT=1: 1 S FI=$O (^CHMXCLF( "B",EI,FI) ) Q:'FI D | |
63 | ..S:CNT=1 FI2=FI,SV CDATE=$P(^ CHMXCLF(FI ,1),"^",11 ) ; SAVE THE INDEX VALUE | |
64 | ..U 0 W:V ERBOSE !," LINE BUFFE R(",CNT,") CHMXCLF (",FI | |
65 | ..I $D(^C HMXCLF(FI) )=0 U 0 W: VERBOSE ?5 0,"UNAVAIL ABLE" | |
66 | .U 0 W:VE RBOSE !!," IMAGE BUFF ER",?40 | |
67 | .I $D(^CH MIMAGE(PDI )) U 0 W:V ERBOSE "CH MIMAGE(",P DI ; DISPLAY THE ^CHMIM AGE() INDE X (PDI) | |
68 | .E U 0 W :VERBOSE " UNAVAILABL E" | |
69 | .I PAYI=0 D | |
70 | ..S PAYI= 0,PAYI=$O( ^CHMPAY("C ",PDI,PAYI )) ; ^CHMPAY "I" INDEX | |
71 | ..S:PAYI PAYJ=0,PAY J=$O(^CHMP AY("C",PDI ,PAYI,PAYJ )) ; ^CHM PAY "J" IN DEX | |
72 | .U 0 W:VE RBOSE !,"P AY BUFFER ",?40 | |
73 | .I +(PAYI ) U 0 W:VE RBOSE "CHM PAY(",PAYI ; REPORT A VAILABLILI TY OF POIN TER TO ^CH MPAY() | |
74 | .E U 0 W :VERBOSE " UNAVAILABL E (REQUIRE D FOR ""CO MPLETE"" C LAIMS)" | |
75 | .S:PAYI C LMTYPE=$$P AYI2TYP(PA YI) ; RETRIEVE C LAIM TYPE FROM ^CHMP AY "ZEMC" XREF (EDI ONLY) | |
76 | .U 0 W !, "PAY ""ZEM C"" XREF " ,?40 | |
77 | .I CLMTYP E'="" D | |
78 | ..S CHTPI D=0,CHTPID =$O(^CHMPA Y(PAYI,"ZE MC",CHTPID )) ; RETR IEVE THE T RADING PAR TNER ID VA LUE | |
79 | ..S CHIDH LD=0,CHIDH LD=$O(^CHM PAY(PAYI," ZEMC",CHTP ID,CHIDHLD )) | |
80 | ..U 0 W:V ERBOSE "^C HMPAY(",PA YI,",""ZEM C"",",CHTP ID,",",CHI DHLD,")= " ,^CHMPAY(P AYI,"ZEMC" ,CHTPID,CH IDHLD) | |
81 | .S:PAYI E DII=0,EDII =$O(^CHMED I("C",PAYI ,EDII)) | |
82 | .U 0 W:VE RBOSE !,"8 35 BUFFER" ,?40,"CHME DI(",EDII | |
83 | .; CREATE AN XML FO R THE ^CLA IM FILE | |
84 | .S APPNAM E="EDIBUFF ER" ; USE APPNAME AS THE ROOT ELEMENT OF XML, AND AS THE CSS FILENAME | |
85 | .S DIRPAT H="CHAMPVA _USER:["_U SER_"]" | |
86 | .S IMGNAM =DIRPATH_" IMG_"_PDI_ ".XML" | |
87 | .S CSSNAM =DIRPATH_" _IMG_"_PDI _".CSS" | |
88 | .S DTDNAM =DIRPATH_" _IMG"_PDI_ ".DTD" | |
89 | .S IMGHDL =$$CRE8XML (IMGNAM,CS SNAM,DTDNA M,"CLM_MOV E",PDI) ; CREA TE XML FIL E AND RETU RN THE "HA NDLE" | |
90 | .I IMGHDL ="" D Q | |
91 | ..U 0 W:I MGHDL="" ! ,"UNABLE T O OPEN THE ",IMGNAM, " FILE FOR WRITING." | |
92 | .; READY TO START P OPULATING THE XML FI LE WITH BU FFER DATA | |
93 | .;D:CLI F ILEBUF(CLI ,IMGHDL) ; WRITE THE ^CHMXCL() FILE BUFFE R CONTENTS TO XML | |
94 | .;D:AI TR XBUF(AI,IM GHDL) ; WR ITE THE ^C HMXCLA() T RANSACTION BUFFER TO XML FILE | |
95 | .;D:BI PR OVBUF(BI,I MGHDL) ; WR ITE THE ^C HMXCLB() P ROVIDER BU FFER TO XM L FILE | |
96 | .;D:CI PA TBUF(CI,IM GHDL) ; WR ITE THE ^C HMXCLC() P ATIENT BUF FER TO XML FILE | |
97 | .D:EI CLM BUF(EI,IMG HDL) ; WR ITE THE ^C HMXCLE() C LAIM BUFFE R TO XML F ILE | |
98 | .;D:EI LI NEBUF(EI,I MGHDL) ; WR ITE THE ^C HMXCLF() L INE BUFFER TO XML FI LE | |
99 | .;D:PDI I MAGBUF(PDI ,IMGHDL) ; WRITE THE ^CHMIMAGE( )IMAGE BUF FER TO XML FILE | |
100 | .;D:PDI I MGBUF(PDI, IMGHDL) ; WR ITE THE ^C HMIMG() BU FFER TO XM L FILE | |
101 | .;D:EDII PAYBUF(EDI I,IMGHDL) ; WRITE THE ^CHMPAY() PAYMENT BU FFER TO XM L FILE | |
102 | .;D:PAYI PAYWRK(PAY I,IMGHDL) ; WRITE THE ^CHMPAYW() "WORK" DA TA TO XML | |
103 | .;D:EDII EDIBUF(EDI I,IMGHDL) ; WRITE THE ^CHMEDI() EDI BUFFER TO XML FI LE | |
104 | .D CLOSEX ML(IMGNAM, IMGHDL,"CL M_MOVE") | |
105 | Q | |
106 | .S DTDHDL =$$CRE8DTD (DTDNAM) ; CREATE THE "DTD FILE ", GET FIL E HANDLE | |
107 | .I (DTDHD L="") D Q | |
108 | ..U 0 W ! ,"UNABLE T O OPEN ",D TDNAM | |
109 | .S CSSHDL =$$CRE8CSS (CSSNAM,"I MGBUFFER", .ELMNTLST, APPNAME) ; CREA TE STYLE S HEET FILE, GET FILE HANDLE | |
110 | .D CLOSEC SS(CSSNAM, CSSHDL) ; CL OSE THE ST YLE SHEET DESCRIPTOR FILE | |
111 | Q | |
112 | ; | |
113 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; | |
114 | ; CRE8XML () FUNCTIO N OPENS TH E OUTPUT F ILE FOR WR ITING THE BUFFER | |
115 | ; INFORMA TION. THER E ARE SPEC IFIC HEADE RS CREATED THAT SUPP ORT THE | |
116 | ; XML FOR MAT. | |
117 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; | |
118 | ; XML FIL E CREATION FUNCTIONS | |
119 | ; CSS FIL E FUNCTION S (STYLE SHEET FIL E) | |
120 | ; DTD FIL E FUNCTION S (DOCUM ENT TYPE D ESCRIPTOR) | |
121 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;; | |
122 | ; | |
123 | CRE8XML(FN AME,CSSNAM ,DTDNAM,AP PNAME,UNIQ UEID) | |
124 | ; FNAME DIR PA TH /FILENA ME IS USED FOR CREAT ING FILE | |
125 | ; CSSNAM DIR PATH / FIL ENAME OF T HE STYLE S HEET FOR T HIS XML FI LE | |
126 | ; DTDNAM DIR PATH / FIL ENAME FOR DOCUMENT T YPE DESCRI PTOR | |
127 | ; APPNAME DOC TYPE AND S TYLE SHEET IS NAMED SAME | |
128 | ; UNIQUEI D FILE NAMING; P DI USED FO R EDIBUFFE R | |
129 | N NAME,CN T,ROOTELM, YR | |
130 | S OPEN=$$ OPENFIWR^C HTFLIB9(.F NAME,FNAME ) | |
131 | I OPEN D | |
132 | .D NOW^%D TC | |
133 | .S TS=X | |
134 | .S YR=$E( TS,1,3),YR =YR+1700 | |
135 | .S TS=$$D TCVRT(YR_$ E(TS,4,7)) | |
136 | .S ROOTEL M=$$LOWER^ CHTFLIB(AP PNAME) ; CONVERTS STRING TO LOWER CAS E | |
137 | .U FNAME W "<?xml v ersion=""1 .0"" encod ing=""UTF- 8"" standa lone=""yes ""?>" | |
138 | .U FNAME W !,"<Expo rt generat or=""Cache "" version =""25"" zv =""Cache f or OpenVMS /ALPHA V8. x (Alpha) 2011.1.2 ( Build 701) "" ts=""20 14-08-14 1 6:37:48""> " | |
139 | .U FNAME W !,"<Rout ine name=" "CHGENXML" " type=""I NT"" langu agemode="" 0"" timest amp="""_TS _""">" | |
140 | .U FNAME W !,"<!--G ENERATED F ILE: "_FNA ME_"-->" | |
141 | .U FNAME W !,"<!--C LAIM ID "_ UNIQUEID_" -->" | |
142 | .U FNAME W !,"<elem ent name= ""CLAIM BU FFERS"" ty pe=""xs:st ring"">" | |
143 | E S FNAM E="" | |
144 | Q FNAME | |
145 | ; | |
146 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
147 | ; CRE8DTD () CREATES THE DTD ( DOCUMENT T YPE DESCRI PTOR) FILE | |
148 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
149 | ; | |
150 | CRE8DTD(FN AME) | |
151 | ; FNAME DIRECT ORY PATH A ND FILENAM E FOR THE "CSS" FILE | |
152 | N OPEN | |
153 | S OPEN=$$ OPENFIWR^C HTFLIB9(.F NAME,"DTD" ) | |
154 | Q:'OPEN " " | |
155 | Q FNAME | |
156 | ; | |
157 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
158 | ; CRE8CSS () CREATES THE CSS S TYLE SHEET FILE FOR THE XML FI LE | |
159 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
160 | ; | |
161 | CRE8CSS(FN AME,APPNAM E,ELEMENTS ,ROOTELM) | |
162 | ; FNAME FILENA ME FOR THE "CSS" FIL E | |
163 | ; APPNAME APPL ICATION NA ME FOR THE CSS FILE | |
164 | ; ELEMENT S STRI NG ARRAY C ONTAINING THE ELEMEN TS TO BE D ISPLAYED | |
165 | ; ROOTELM ROOT ELEMENT | |
166 | N NAME,RE TURN,CNT,O PEN | |
167 | S RETURN= "" | |
168 | S OPEN=$$ OPENFIWR^C HTFLIB9(.F NAME,FNAME ) | |
169 | I OPEN D | |
170 | .S RETURN =FNAME | |
171 | .U FNAME W !,"edi_b uffers {", !,?5,"back ground-col or: lights teelblue;" ,!,?5,"dis play: bloc k;",!,?5," padding: 1 0px;",!,?5 ,"font-fam ily: couri er new;",! ,"}" | |
172 | .U FNAME W !,"eleme nt {",!,?5 ,"backgrou nd-color: chartreuse ;",!,?5,"b order: 2px solid bla ck;",!,?5, "font-weig ht: bold;" ,!,?5,"dis play: bloc k;",!,?5," margin-bot tom: 10px; ",!,"}" | |
173 | .U FNAME W !,"eleme nt:before {content: ""ELEMENT: ""}" | |
174 | .U FNAME W !,"start {",!,?5," font-weigh t: bold;", !,?5,"disp lay:block; ",!,"}" | |
175 | .U FNAME W !,"field {",!,?5," font-weigh t: bold;", !,?5,"disp lay: inlin e-block;", !,"width: 350px",!," }" | |
176 | .;U FNAME W !,"fiel d:before { content: " "DATA FIEL D: ""}" | |
177 | .U FNAME W !,"data {",!,?5,"f ont-weight : bold;",! ,?5,"displ ay: inline ;",!,"}" | |
178 | .;U FNAME W !,"data :before {c ontent: "" VALUE: " "}" | |
179 | .U FNAME W !,"end { ",!,?5,"fo nt-weight: bold;",!, ?5,"displa y:block;", !,"}" | |
180 | Q FNAME | |
181 | ; | |
182 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
183 | ; CLOSECS S() CLOSES THE STYLE SHEET FIL E CREATED FOR THIS A PPLICATION | |
184 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
185 | ; | |
186 | CLOSECSS(F NAME,HANDL E) | |
187 | D CLOSEF^ CHTFLIB9(F NAME,HANDL E) | |
188 | Q | |
189 | ; | |
190 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
191 | ; CLOSEXM L() WRITES THE "END" FOR THE R OOT ELEMEN T AND CLOS ES THE FIL E | |
192 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
193 | ; | |
194 | CLOSEXML(F NAME,HANDL E,APPNAME) | |
195 | N ROOTELM | |
196 | S ROOTELM =$$LOWER^C HTFLIB(APP NAME) ; CONVERTS STRING TO LOWER CAS E | |
197 | U FNAME W !,"</elem ent>" ; CLOSE TH E ROOT ELE MENT GROUP | |
198 | U FNAME W !,"</Rout ine>" | |
199 | U FNAME W !,"</Expo rt>" | |
200 | U 0 W !," CREATED HO ST XML FIL E: ",FNAME | |
201 | D CLOSEF^ CHTFLIB9(F NAME,HANDL E) | |
202 | Q | |
203 | ; | |
204 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
205 | ; START E LEMENT FUN CTION OUTP UTS THE RE QUIRED XML FIELDS FO R THE STAR T | |
206 | ; OF EACH ELEMENT F IELD | |
207 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
208 | ; | |
209 | STARTELE(G NAME,HANDL E) | |
210 | ; GNAME THE GLOBAL NAM E TO BE WR ITTEN | |
211 | ; HANDLE THE FI LE HANDLE TO BE WRIT TEN | |
212 | N SIDX,EI DX,FNUMBER ,BUFNAME | |
213 | S SIDX=$L ($P(GNAME, "(",1))+2, EIDX=$L(GN AME)-1 | |
214 | S BUFNAME =$P(GNAME, "(",1) | |
215 | S FNUMBER =$$GETFNUM (BUFNAME) ; US E THE PROV IDED GLOBA L NAME TO GET FILE N UMBER | |
216 | U HANDLE W !,?5,"<b uffer>"_BU FNAME_" FI LE #:"_FNU MBER_": FI LENAME:"_$ E(GNAME,1, (SIDX-1))_ ": IDX="_$ E(GNAME,SI DX,EIDX)_" </buffer>" | |
217 | U 0 W:VER BOSE !,?5, "DEBUG: < buffer>"_B UFNAME_" F ILE #:"_FN UMBER_": F ILENAME:"_ $E(GNAME,1 ,(SIDX-1)) _": IDX:"_ $E(GNAME,S IDX,EIDX)_ ":</buffer >" | |
218 | Q | |
219 | ; | |
220 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
221 | ; END ELE MENT FUNCT ION OUTPUT S THE REQU IRED XML F IELDS FORT HE END OF AN | |
222 | ; ELEMENT . | |
223 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
224 | ; | |
225 | ENDELE(GNA ME,HANDLE) | |
226 | ; GNAME THE GLOBAL NAM E TO BE WR ITTEN | |
227 | ; HANDLE THE FI LE HANDLE TO BE WRIT TEN | |
228 | ;U HANDLE W !,?15," <end></end >" | |
229 | U HANDLE W !,?5,"</ element>" | |
230 | Q | |
231 | ; | |
232 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
233 | ; GLBLDMP () ACCEPTS THE GLOBA L NAME OR NODE THAT THE USER W ANTS TO DI SPLAY | |
234 | ; OR WRIT TEN TO A F ILE. THE I NTENT AT T HE TIME OF WRITING I S TO CREAT E AN | |
235 | ; XML FIL E THAT CON TAINS A CL AIM IN ITS ENTIRETY. THE RESUL TING XML F ILE | |
236 | ; COULD B E USED TO MOVE THE C LAIM DATA TO ANOTHER ENVIRONME NT ("DEV"/ "TEST"/ | |
237 | ; "PREPRO D"), OR PO TENTIALLY FOR USE TO "REOPEN" A COMPLETE D CLAIM ON THE | |
238 | ; PRODUCT ION SERVER . | |
239 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
240 | ; THE RES ULT IS THE EXTRACTIO N AND PROC ESSING OF ALL NODES ASSOCIATED WITH | |
241 | ; THE BAS E INDEX OF THE GLOBA L DEFINED BY "GNAME" . THIS IS THE COMMON ENTRY | |
242 | ; POINT F OR ALL OF THE BUFFER FILE EXTR ACTIONS. | |
243 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
244 | ; | |
245 | GLBLDMP(GN AME,TARGIO ,NAMLEN) | |
246 | ; GNAME GLOB AL NAME TO BE DUMPED WITH THE "I" INDEX | |
247 | ; TARGIO IO H ANDLE FOR OUTPUT | |
248 | ; NAMLEN LENG TH OF NAME FOR XML O UTPUT | |
249 | I $D(GNAM E) D | |
250 | .D DUMPGL BL(GNAME,T ARGIO,NAML EN) ; DI SPLAY/OUTP UT THE GLO BAL INFORM ATION | |
251 | Q | |
252 | ; | |
253 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
254 | ; DUMPGLB L(NODE,TIO ) USES TH E ^DD(FILE NUM,"GL") CROSS-REFE RENCE TO R ETRIEVE | |
255 | ; THE FIE LD NAMES A ND TO GENE RATE THE N ODE ADDRES S TO RETRI EVE THE DA TA | |
256 | ; LEGEND FOR RETURN OF $DATA CHECK: | |
257 | ; 0 = VAL UE TESTED IS UNDEFIN ED | |
258 | ; 1 = VAL UE TESTED IS DEFINED AND CONTA INS DATA | |
259 | ; 10 = VA LUE TESTED IS DEFINE D BUT IS O NLY A POIN TER TO SUB SCRIPTED E NTRY | |
260 | ; 11 = VA LUE TESTED IS DEFINE D AND CONT AINS BOTH DATA AND A POINTER T O A SUBSCR IPTED ENTR Y | |
261 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
262 | ; | |
263 | DUMPGLBL(G NAME,TIO,N AMLEN) | |
264 | ; GNAME GLOBAL NAME AND INDEX TO W RITE TO XM L FILE | |
265 | ; TIO XML FI LE HANDLE | |
266 | ; NAMLEN LENGTH OF THE GL OBAL NAME | |
267 | N FILENUM ,MFILENUM, INDX,REG,C NT,NODE,DN ODE,WNODE, NEWFNUM,NE WFNUM1,REG NUM,MSUB1, MSUB2,LSUB ,DDSUB,DDC NT,FSUB | |
268 | N MNAME,E XIT,QUIT,I EN,E0N,PRV FNUM,MULT, MLOOP | |
269 | S REGNUM= "",REG="", EON=0,PRVF NUM="" | |
270 | S NODE=GN AME | |
271 | S IEN=$$G ETIEN(NODE ) ; GET THE IE N INDEX FR OM THE GLO BAL | |
272 | U 0 W:VER BOSE !,"DU MPGLBL: N ODE ADDRES S = ",NODE | |
273 | I $P($P(N ODE,"(",2) ,",",1)?1A D | |
274 | .I $D(@NO DE) D | |
275 | ..D WRTXR EF(NODE,TI O) | |
276 | S FILENUM =$$GETFNUM (GNAME) ; GET THE BA SE FILE NU MBER BASED ON THE FI LE NAME | |
277 | F S REGN UM=$O(^DD( FILENUM,"G L",REGNUM) ) Q:(REGN UM="")!(EO N) D ; FOR EACH INDEX, GE T EACH OF THE FIELD NUMBERS | |
278 | .S MULT=0 | |
279 | .U 0 W:VE RBOSE !!," DUMPGLBL: NEW ^DD A DDRESS= ^D D(",FILENU M,",""GL"" ,",REGNUM, ")" | |
280 | .S NEWFNU M=$$ISMULT (FILENUM,R EGNUM) ; CHECK THE ^DD(FI LENUM) NOD E TO SEE I F IT IS "M ULTIPLE" N ODE | |
281 | .I NEWFNU M D ; YE S, IT IS A "MULTIPLE " NODE DO THIS CODE BLOCK | |
282 | ..U 0 W:V ERBOSE " ***YES*** MULTIPLE : MFILENUM = ",NEWFNU M | |
283 | ..S MULT= MULT+1,MLO OP=1 ; DO MULTIPL E LOOPS AS LONG AS T HERE IS DA TA | |
284 | ..S MFILE NUM=NEWFNU M,EOMN=0,M NODE=NODE, MREG="" ; SET UP THE NEW FILE NUMB ER FOR THE "MULTIPLE " NODE | |
285 | ..F Q:EO MN S MREG =$O(^DD(MF ILENUM,"GL ",MREG)) Q :MREG="" D ; FOR EA CH INDEX, GET EACH O F THE FIEL D NUMBERS | |
286 | ...U 0 W: VERBOSE !! ,"DUMPGLBL : LOOP2: MULTIPLE ^ DD ADDRESS = ^DD(",MF ILENUM,"," "GL"",",MR EG,")" | |
287 | ...S NEWF NUM1=$$ISM ULT(MFILEN UM,MREG) ; CHECK THE ^DD(FI LENUM) NOD E TO SEE I F IT IS "M ULTIPLE" N ODE | |
288 | ...S:NEWF NUM1 MFILE NUM=NEWFNU M1 ; GET THE NEW "MULTI PLE" FILE NUMBER FOR NEXT FIEL D/DATA RET RIEVAL | |
289 | ...S FIEL DS=$$GETFI ELDS(MFILE NUM,MREG,1 ) ; RETRIE VE THE FIE LDS FOR TH E CURRENT FILE NUMBE R | |
290 | ...S DATA ="",MLOOP= 1 ; INIT DATA FOR NODE N OT POPULAT ED | |
291 | ...S REG= REGNUM ; SE T THE VALU E OF REG B ASED ON TH E MATCH/MI SMATCH OF FILE NUMBE RS | |
292 | ...S:$L(M NODE,",")> 2 REG=MREG ; SET FOR THE MREG V ALUE FOR ( I,70,1,X,0 ) | |
293 | ...U 0 W: VERBOSE !, "DUMPGLBL: LOOP2: M FILENUM: " ,MFILENUM, " PRVFNUM = ",PRVFNU M," MREG= ",MREG," REGNUM= " ,REGNUM," MLOOP= ", MLOOP | |
294 | ...S MNOD E=$$GETMNO DE(MNODE,R EG,MFILENU M,PRVFNUM, .MLOOP) ; THE "MULTI PLE" DATA NODE MNODE + REG NUM BER | |
295 | ...S PRVF NUM=MFILEN UM,EXIT=0 ; SAVE THE WORKING F ILE NUMBER FOR FUTUR E USE | |
296 | ...S EXIT =$$OUTPUTM (MNODE,TIO ,FIELDS,DA TA,.MLOOP) | |
297 | ...F IDX= 2:1 Q:EXI T D | |
298 | ....S MNO DE=$$SETID X(MNODE,ID X) ; INCREMEN T THROUGH THE "MULTI PLE" INDEX COUNTS | |
299 | ....S EXI T=$$OUTPUT M(MNODE,TI O,FIELDS,D ATA,.MLOOP ) | |
300 | ....I EXI T S MNODE= $$SETIDX(M NODE,1) | |
301 | .E D ; WE G ET HERE IF NOT A "MU LTPLE" NOD E | |
302 | ..U 0 W:V ERBOSE " *** NOT ** ** MULTIPL E" | |
303 | ..S FIELD S=$$GETFIE LDS(FILENU M,REGNUM,0 ) ; RETRIE VE THE FIE LDS FOR TH E CURRENT FILE NUMBE R | |
304 | ..S DATA= "" ; IN IT DATA FO R NODE NOT POPULATED | |
305 | ..S NODE= $$GETNODE( NODE,REGNU M) ; CREATE T HE DATA NO DE ADDRESS FOR DATA RETRIEVAL | |
306 | ..U 0 W:V ERBOSE !," DUMPGLBL: LOOP1 NODE = ",NODE | |
307 | ..S EON=$ $ENDOFNODE (IEN,NODE) ; CHECK FO R END OF N ODE BASED ON INDEX V ALUE | |
308 | ..Q:EON ; EXIT IF EON=TR UE | |
309 | ..S PRVFN UM=FILENUM ; SAVE THE F ILE NUMBER FOR FUTUR E USE | |
310 | ..I ('$D( @NODE)!($D (@NODE)#10 '=1)) D ; IF NOD E ISN'T DE FINED OR I F NOT POPU LATED WITH DATA | |
311 | ...U 0 W !,"DUMPGLB L: ",NODE, " IS NOT POPULATED" | |
312 | ...S DATA ="",EXIT=1 ; WRITE THE FIELDS WIT H BLANK DA TA | |
313 | ...Q:NODE ["B" D ; DO NOT WRITE IF BLANK XREF | |
314 | ...D WRIT EXML(NODE, TIO,FIELDS ,DATA) ; WRITE THE FIELD NAMES AND BLANK DATA TO THE XM L FILE | |
315 | ..E D ; ELSE IF NODE C ONTAINS DA TA | |
316 | ...S DATA =@NODE ; RE TRIEVE THE DATA VALU ES | |
317 | ...D WRIT EXML(NODE, TIO,FIELDS ,DATA) ; WRITE THE FIELD NAMES AND DATA TO TH E XML FILE | |
318 | Q | |
319 | ; | |
320 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
321 | ; OUTPUTM (MNODE,TIO ,FIELDS,DA TA) DETER MINES IF N ODE HAS DA TA, AND EI THER OUTPU TS | |
322 | ; THE DAT A, OR OUTP UTS THE FI ELDS AND N ULL DATA | |
323 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
324 | ; | |
325 | OUTPUTM(MN ODE,TIO,FI ELDS,DATA, MLOOP) | |
326 | ; MNODE THE NO DE ADDRESS TO OUTPUT | |
327 | ; TIO THE TA RGET IO FI LE | |
328 | ; FIELDS THE FI ELD NAMES FOR THE NO DE(S) | |
329 | ; DATA THE DA TA TO BE W RITTEN | |
330 | ; MLOOP LOOP C OUNTER TO BLOCK REDU NDANT OUTP UT | |
331 | N DVAL,EX IT | |
332 | S EXIT=0 | |
333 | S DVAL=$D (@MNODE) ; IS CNODE P OINTER, DA TA OR BOTH ? | |
334 | U 0 W:VER BOSE !,?10 ,"OUTPUTM: MNODE= " ,MNODE," $D(@MNODE) = ",DVAL," MLOOP= " ,MLOOP | |
335 | I DVAL#10 '=1 D ; IF NODE CO NTAINS NO DATA | |
336 | .U 0 W:VE RBOSE !,?1 0,"OUTPUTM : ",MNODE ," CONTAIN S NO DATA" | |
337 | .S DATA=" " ; EX IT THE LOO P TO GET N EXT NODE F ROM ^DD() (EOMN: END OF MULTIP LE NODE) | |
338 | .I MLOOP= 1 D | |
339 | ..D WRITE XML(MNODE, TIO,FIELDS ,DATA) ; WR ITE THE FI ELD NAMES AND BLANK DATA TO TH E XML FILE | |
340 | .S EXIT=1 | |
341 | E D ; EL SE THE NOD E CONTAINS POINTER O R USER DAT A | |
342 | .S DATA=@ MNODE ; GET THE DA TA FROM TH E GLOBAL N ODE | |
343 | .D WRITEX ML(MNODE,T IO,FIELDS, DATA) ; ELSE W RITE THE F IELD NAMES AND DATA TO THE XML FILE | |
344 | .S MLOOP= MLOOP+1 | |
345 | Q EXIT | |
346 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
347 | ; SETIDX( NODE,IDX) RESETS THE MOST RECE NT VARIABL E INDES (J ,K,L) TO 1 | |
348 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
349 | ; | |
350 | SETIDX(NOD E,IDX) | |
351 | ; NODE THE MULTIPLE N ODE TO BE RESET | |
352 | N LSTSUB, SUBLEN,WNO DE | |
353 | S WNODE=N ODE | |
354 | S FLDCNT= $L(WNODE," ,") | |
355 | S $P(WNOD E,",",FLDC NT-1)=IDX | |
356 | Q WNODE | |
357 | ; | |
358 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
359 | ; SETCONS T(WNODE,VA L) SETS T HE LAST CO NSTANT IN THE NODE T O "VAL" | |
360 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
361 | ; | |
362 | SETCONST(N ODE,NUM,VA L) | |
363 | ; WNODE THE WORK ING NODE T O BE CHANG ED | |
364 | ; NUM THE VALU E NUMBER T O REPLACE | |
365 | ; VAL THE VALU E TO BE WR ITTEN INTO THE NODE | |
366 | N WNODE,F LDCNT | |
367 | S WNODE=N ODE | |
368 | S FLDCNT= $L(WNODE," ,") ; GE T THE NUMB ER OF FIEL DS IN THE NODE | |
369 | S $P(WNOD E,",",NUM) =VAL ; SE T THE VALU E INTO THE NODE | |
370 | I (NUM=FL DCNT)&($E( $L(WNODE)- 1,$L(WNODE )-1)'=")") D | |
371 | .S WNODE= WNODE_")" | |
372 | Q WNODE | |
373 | ; | |
374 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
375 | ; GETFNUM () RETURNS THE FILE NUMBER FOR THE PROVI DED FILE N AME | |
376 | ; ANY COM BINATION O F THE NODE IS VIABLE SO LONG A S IT HAS T HE BUFFER | |
377 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
378 | ; | |
379 | GETFNUM(NO DE) | |
380 | ; NODE THE CURRENT WO RKING BUFF ER NAME (I .E ^CHMXCL F(812345,0 ) OR ^CHMX CLF(812345 | |
381 | N FNUMARR ,FNUM | |
382 | S FNUMARR ("^CHMXCL" )="741210. 04^CLAIM F ILE" ; SET UP A N ARRAY OF FILE NUMB ERS FOR CL AIM BUFFER S | |
383 | S FNUMARR ("^CHMXCLA ")="741210 .06^TRANSA CTION" | |
384 | S FNUMARR ("^CHMXCLB ")="741210 .08^PROVID ER" | |
385 | S FNUMARR ("^CHMXCLC ")="741210 .1^PATIENT " | |
386 | S FNUMARR ("^CHMXCLE ")="741210 .12^CLAIM" | |
387 | S FNUMARR ("^CHMXCLF ")="741210 .14^SERVIC E LINE" | |
388 | S FNUMARR ("^CHMIMAG E")="74100 0.1^IMAGE" | |
389 | S FNUMARR ("^CHMIMG" )="741000. 2^IMAGE" | |
390 | S FNUMARR ("^CHMPAY" )="741000^ PAYMENT" | |
391 | S FNUMARR ("^CHMPAYW ")="741002 .602^WORK FLOW" | |
392 | S FNUMARR ("^CHMEDI" )="741207. 01^835 STA TUS" | |
393 | S FNUM=$P (FNUMARR($ P(NODE,"(" ,1)),"^",1 ) ; EXTRACT TH E FILE NAM E FROM THE NODE INFO RMATION | |
394 | Q FNUM | |
395 | ; | |
396 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ; | |
397 | ; GETLSTS UB(NODE) E XTRACTS TH E LAST SUB SCRIPT FRO M THE PROV IDED NODE | |
398 | ; THIS WI LL BE USED IN THE GE TFIELDS() FUNCTION | |
399 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ; | |
400 | ; | |
401 | GETLSTSUB( GNODE) | |
402 | ; GNODE THE WORK ING GLOBAL NODE | |
403 | N SUBNUM, SUB | |
404 | S SUBNUM= $L(GNODE," ,") ; GET THE NUMBER OF SUBSCR IPTS | |
405 | S SUB=$P( GNODE,",", SUBNUM) ; GET THE LAST S UBSCRIPT | |
406 | S SUB=$P( SUB,")",1) ; REMO VE THE FOL LOWING ")" | |
407 | Q SUB | |
408 | ; | |
409 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
410 | ; ISMULT( ) IS A BOO LEAN FUNCT ION THAT R ETURNS "FA LSE (0)" I F THE PROV IDED NODE | |
411 | ; IS NOT A "MULTIP LE" NODE, AND TRUE(N ON-ZERO) I F THE NODE IS A "MUL TIPLE". | |
412 | ; *** THE ^DD(FILEN UM,"GL") C ROSS-REFER ENCE CONTA INS A "0" IN THE 4TH POSITION | |
413 | ; IF THE NODE IS A "MULTIPLE" NODE. | |
414 | ; *** THE RE IS ANOT HER CROSS- REFERENCE FOR "MULTI PLE" NODES ; THE | |
415 | ; ^DD(FIL ENUM,"SB", FILENUM_ID X,IDX) CRO SS-REFEREN CE | |
416 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
417 | ; | |
418 | ISMULT(FIL ENUM,IDX) | |
419 | ; NODE THE NODE TO BE TESTED | |
420 | N DDVAL,M ULT,SBREF, RETURN,SBI DX,MFILE,M FILENUM | |
421 | S RETURN= 0 ; DEFAULT TO NON-MUL TIPLE RETU RN | |
422 | S DDVAL=" ^DD("_FILE NUM_",""GL "","_IDX_" ,"_0_")" ; BUILD TH E "GL" CRO SS-REFEREN CE NODE FO R MULTIPLE CHECK | |
423 | U 0 W:VER BOSE !,?15 ,"ISMULT: DDVAL= ", DDVAL | |
424 | S MULT=$D (@DDVAL) ; FIRST CHECK FOR NODE IS A "MULTIPLE" | |
425 | ;U 0 W:VE RBOSE !,?1 5,"ISMULT: $D(DDVAL )= ",MULT | |
426 | I MULT=10 D | |
427 | .S MFILE= "^DD("_FIL ENUM_",IDX ,"_0_")" | |
428 | .I $D(@MF ILE) D ; TEST B EFORE ATTE MPTING TO RETRIEVE T HE "MULTIP LE"FILE NU MBER | |
429 | ..;U 0 W: VERBOSE !, ?15,"ISMUL T: $D(MFI LE)= ",$D( MFILE) | |
430 | .S MFILEN UM=$P((@MF ILE),"^",2 ) ; GE T THE "MUL TIPLE" FIL ENUMBER | |
431 | .S:MFILEN UM RETURN= MFILENUM | |
432 | .;U 0 W:V ERBOSE !,? 5,"ISMULT: MFILE= " ,MFILE," MULT CHECK #2= ",RET URN | |
433 | Q RETURN | |
434 | ; | |
435 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
436 | ; GETNODE (NODE,REG) RETURNS T HE NODE AD DRESS FOR NON-MULTIP LE NODES | |
437 | ; NOTE: T HIS FUNCTI ON RETURNS THE NODE ADDRESS EV EN IF IT I S NOT POPU LATED | |
438 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
439 | ; | |
440 | GETNODE(NO DE,REG) | |
441 | ; NODE THE NON-MULTIP LE NODE | |
442 | ; REG THE REGISTER N UMBER FOR THE CURREN T NODE | |
443 | N WNODE,S UBLEN,LSTS UB | |
444 | U 0 W:VER BOSE !,?10 ,"GETNODE: INPUT= " ,NODE | |
445 | S LSTSUB= $$GETLSTSU B(NODE) | |
446 | S SUBLEN= $L(LSTSUB) | |
447 | S WNODE=N ODE,RTN=0 ; GET THE "MULTI PLE" NODE INOT THE W ORKING VAR IABLE | |
448 | S WNODE=( $E(NODE,1, $L(NODE)-( SUBLEN+1)) ) ; REMOVE T HE LAST SU BSCRIPT AN D CLOSING PAREN | |
449 | S WNODE=W NODE_REG_" )" ; SE T THE REGI STER INTO THE NODE A DDRESS | |
450 | U 0 W !,? 10,"GETNOD E: RETURN = ",WNODE | |
451 | Q WNODE | |
452 | ; | |
453 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
454 | ; GETMNOD E() RETURN S THE DATA NODE ADDR ESS FOR TH E "MULTIPL E" NODE RE TRIEVED | |
455 | ; FROM TH E ^DD(FILE NUM) DATA DICTIONARY . | |
456 | ; THIS FU NCTION WIL L WORK IND EPENDENTLY OF THE AC TUAL "MULT IPLE" INDE X TO | |
457 | ; RETRIEV E. THIS IS BECAUSE T HE INCOMIN G NODE DES CRIPTION W ILL CONTAI N THE | |
458 | ; STARTIN G POINT FO R THE NODE BEING WOR KED. | |
459 | ; I.E NOD E="^CHMXCL F(IEN,5)", WILL RETU RN "^CHMXC LF(IEN,5,J ,0)" | |
460 | ; "^CHMX CLF(IEN,70 ,J,101) WI LL RETURN ^CHMXCLF(I EN,70,J,10 1,K,0) | |
461 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
462 | ; | |
463 | GETMNODE(N ODE,REG,FN UM,PRVFNUM ,MLOOP) | |
464 | ; NODE THE MU LTIPLE NOD E (CONTAIN S THE IEN AND POTENT IALLY OTHE R INDEXES) | |
465 | ; REG THE RE GISTER VAL UE FOR CRE ATING THE NODE ADDRE SS | |
466 | ; FNUM CURREN T NODE FIL E NUMBER | |
467 | ; PRVFNUM THE PR EVIOUS NOD E FILE NUM BER | |
468 | ; MLOOP EACH S UCCESSIVE "MULTIPLE" ADDS A VA RIABLE IND EX TO THE NODE ADDRE SS (J,K,L, M) | |
469 | N WNODE,T NODE,CNT,I DX,FLDCNT, NUM | |
470 | U 0 W !,? 10,"GETMNO DE: IN: NODE= ",NO DE," REG= ",REG," FNUM= ",FN UM," PREV FNUM= ",P RVFNUM," MLOOP= ",M LOOP | |
471 | S WNODE=N ODE ; GET THE "MULTI PLE" NODE INTO THE W ORKING VAR IABLE | |
472 | I FNUM=PR VFNUM D | |
473 | .U 0 W:VE RBOSE !,"F ILE NUMBER S MATCH!" ; FILE NUM BERS CHANG ED, SO NOD E ADDRESSI NG CHANGES | |
474 | .I FNUM[7 41210.14 D | |
475 | ..S IDX=$ O(@WNODE) | |
476 | ..S FLDCN T=$L(WNODE ,",") | |
477 | ..S WNODE =$$SETCONS T(WNODE,FL DCNT,IDX) ; REPLACE THE LAST C ONSTANT WI TH "IDX" | |
478 | .E I FNU M=741210.1 27 D | |
479 | ..U 0 W:V ERBOSE !,? 10,"^CHMXC LE() NODE RETRIEVE: IN= ",WNOD E | |
480 | ..S FLDCN T=$L(WNODE ,",") ; GE T THE NUMB ER OF FIEL DS IN THE NODE | |
481 | ..S WNODE =$$SETCONS T(WNODE,FL DCNT,REG) ; REPLACE THE LAST S UBSCRIPT | |
482 | ..U 0 W:V ERBOSE !,? 10,"^CHMXC LE() NODE RETRIEVE: OUT= ",WNO DE | |
483 | E D | |
484 | .U 0 W:VE RBOSE !,"F ILE NUMBER S CHANGED! " ; FILE NUM BERS SAME, GET NEXT NODE | |
485 | .I $L(WNO DE,",")>2 D | |
486 | ..S WNODE =$$SETCONS T(WNODE,4, REG) | |
487 | .E S WNO DE=$$SETCO NST(WNODE, 2,REG) | |
488 | .I $D(@WN ODE) D ; IF ( I,X) IS A VALID NODE | |
489 | ..S WNODE =$E(WNODE, 1,$L(WNODE )-1) ; REMOVE THE CLOSING P AREN | |
490 | ..S IDX=0 | |
491 | ..S WNODE =WNODE_"," _IDX_")" ; THE "J","K ",OR "L" I NDEX SHOUL D NEVER BE "0" | |
492 | ..S IDX=$ O(@WNODE) | |
493 | ..S:'IDX IDX=1 | |
494 | ..S LSTSU B=$$GETLST SUB(NODE) | |
495 | ..S SUBLE N=$L(LSTSU B) | |
496 | ..S WNODE =($E(WNODE ,1,$L(WNOD E)-(SUBLEN +1))) ; REMOVE THE LAST SUBSCRIPT AND CLOSIN G PAREN | |
497 | ..S WNODE =WNODE_"," _IDX_",0)" | |
498 | .E D | |
499 | ..S WNODE =$E(WNODE, 1,$L(WNODE )-1) ; REMOVE THE CLOSING P AREN | |
500 | ..S WNODE =WNODE_",1 ,0)" | |
501 | .U 0 W:VE RBOSE !,?1 0,"GETMNOD E: RETURN WNODE= " ,WNODE ; IF NOD E NOT POPU LATED, RET URN THE PR OVIDED NOD E | |
502 | Q WNODE | |
503 | ; | |
504 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
505 | ; GETNXTI DX(NODE,RE G) PERFORM S THE GATH ERING OF T HE NEXT VA RIABLE IND EX FOR | |
506 | ; A NODE. | |
507 | ; EXAMPLE : THE PREV IOUS NODE (^CHMXCLF( I,70,J,.5) = FILE NU MBER 74121 0.147 | |
508 | ; NEXT AD DRESS HAS THE CONSTA NT VALUE " 101" AS TH E REGISTER VALUE. | |
509 | ; THE $D( ^CHMXCLF(I ,70,1,101) ) AND HAS FILE NUMBE R 741210.1 47101 | |
510 | ; IN ORDE R TO GET T O THE NEXT NODE ADDR ESS, YOU N EED TO GET THE | |
511 | ; NEXT VA RIABLE IND EX FOR THE MULTIPLE (I,70,J,10 1,K,0) | |
512 | ; THIS FU NCTION DOE S THAT FOR YOU | |
513 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
514 | ; | |
515 | GETNXTIDX( NODE,REG) | |
516 | ; NODE THE CURRENT NO DE ADDRESS | |
517 | ; REG THE REGISTER V ALUE FOR G ENERATING THE NEXT N ODE ADDRES S | |
518 | U 0 W !,? 5,"GETNXTI DX: NODE= ",NODE," REG= ",RE G | |
519 | N WNODE,T NODE,IDX | |
520 | S WNODE=N ODE ; GET THE "MULTI PLE" NODE INOT THE W ORKING VAR IABLE | |
521 | S WNODE=( $E(NODE,1, $L(NODE)-1 )) ; REMOVE THE CLOSING P AREN | |
522 | S TNODE=W NODE ; KEEP A COPY OF THE TRUNC ATED NODE ADDRESS | |
523 | U 0 W:VER BOSE !,?5, "GETNXTIDX : TNODE= ",TNODE | |
524 | S WNODE=W NODE_","_R EG_")" ; SE T UP WNODE FOR $O(WN ODE) | |
525 | U 0 W:VER BOSE !,?5, "GETNXTIDX : SETUP W NODE= ",WN ODE | |
526 | S IDX=0 ; THE "J ","K",OR " L" INDEX S HOULD NEVE R BE "0" | |
527 | S IDX=$O( @WNODE) | |
528 | S:'IDX ID X=1 | |
529 | U 0 W:VER BOSE !,?5, "GETNXTIDX : IDX= ", IDX | |
530 | S WNODE=T NODE_","_I DX_",0)" ; BUILD THE NODE ADDRE SS FOR THE DATA NODE | |
531 | U 0 W !,? 5,"GETMNOD E: RETURN = ",WNODE ; IF NODE NOT POPULA TED, RETUR N THE PROV IDED NODE | |
532 | Q WNODE | |
533 | ; | |
534 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
535 | ; THIS FU NCTION RET URNS THE S UBNODE TO THE PREVIO US DATA NO DE | |
536 | ; I.E. ^C HMXCLF(IEN ,70,1,0) S UBNODE ^CH MXCLF(IEN, 70,1,.5) | |
537 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
538 | ; | |
539 | GETMNODE1( NODE,REG) | |
540 | ; NODE THE MULTIPLE N ODE (CONTA INS THE IE N AND POTE NTIALLY OT HER INDEXE S) | |
541 | N WNODE,T NODE,CNT,I DX,LEN | |
542 | U 0 W !,? 5,"GETMNOD E1: NODE= ",NODE | |
543 | S LEN=$L( $$GETLSTSU B(NODE)) | |
544 | S TNODE=$ E(NODE,1,$ L(NODE)-(L EN+1)) ; GET THE "M ULTIPLE" N ODE INTO T HE WORKING VARIABLE | |
545 | U 0 W !,? 5,"GETMNOD E1: TNODE = ",TNODE | |
546 | S WNODE=N ODE | |
547 | U 0 W !,? 5,"GETMNOD E1: SETUP = ",WNODE | |
548 | S IDX=$O( @WNODE) | |
549 | S WNODE=T NODE_IDX_" )" ; BUIL D THE NODE ADDRESS F OR THE DAT A NODE | |
550 | U 0 W !,? 5,"GETMNOD E1: SETUP = ",WNODE | |
551 | I '$D(@WN ODE) D | |
552 | .U 0 W !, ?5,"GETMNO DE1: ",WN ODE," IS NOT POPULA TED" | |
553 | U 0 W !,? 5,"GETMNOD E1: RETUR N= ",WNODE ; IF NODE NO T POPULATE D, RETURN THE PROVID ED NODE | |
554 | Q WNODE | |
555 | ; | |
556 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
557 | ; GETSUB MATCHES TH E VALUES P ROVIDED TO THE ^DD(F ILENUM,"GL ",REG,CNT, SUBVAL) | |
558 | ; CROSS-R EFERENCE | |
559 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
560 | ; | |
561 | GETSUB(FIL ENUM,REG,S UBVAL) | |
562 | ; FILENU M THE FI LE NUMBER FOR ^DD(FI LENUM,"GL" ,REG,CNT,S UBVAL) | |
563 | ; REG THE RE GISTER VAL UE FOR ^DD (FILENUM," GL",REG,CN T,SUBVAL) | |
564 | ; SUBVAL THE ^D D(FILENUM, "GL",REG,C NT,SUBVAL) | |
565 | N EXIT,RS UB,CNT,RTN | |
566 | S EXIT=0, RTN=0 | |
567 | F CNT=1:1 Q:EXIT D | |
568 | .S RSUB=$ O(^DD(FILE NUM,"GL",R EG,CNT,"") ) | |
569 | .U 0 W !, "GETSUB(): $O(^DD(", FILENUM,", ""GL"",",R EG,",",CNT ,")= ",$O( ^DD(FILENU M,"GL",REG ,CNT,"")) | |
570 | .S:RSUB=( REG+SUBVAL ) RTN=CNT, EXIT=1 | |
571 | Q RTN | |
572 | ; | |
573 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
574 | ; GETFIEL DS(FILENUM , SUB) RET RIEVES THE FIELD NAM ES FROM TH E DATA DIC TIONARY | |
575 | ; USING T HE "GL" CR OSS-REFERE NCES. | |
576 | ; | |
577 | ; NOTE: T HERE ARE T IMES WHEN THE CNT VA LUE IS MIS SING BECAU SE THE FIL E WAS CREA TED | |
578 | ; INCORRE CTLY, SO T HE FUNCTIO N TAKES TH AT INTO AC COUNT. | |
579 | ; EXAMPLE : | |
580 | ; ^DD(74 1210.14,"G L",1,12,1. 12)="" | |
581 | ; THE "1 3" COUNT W AS OMITTED IN THE NO DE. | |
582 | ; ^DD(74 1210.14,"G L",1,14,1. 14)="" | |
583 | ; ^DD(74 1210.14,"G L",1,15,1. 15)="" | |
584 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
585 | ; NOTE: T HERE ARE S PECIFIC FI ELD INDEXE S WITHIN S OME GLOBAL S THAT ARE MISSING, | |
586 | ; AND THESE MUST BE HANDLE D IN ORDER TO RETRIE VE ALL OF THE VALID FIELDS. | |
587 | ; EXAM PLE: ^CHMX CLF(I,1), FIELD 13 D OES NOT EX IST | |
588 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
589 | ; | |
590 | GETFIELDS( FILENUM,SU B,MULT) | |
591 | ; FILENUM USER PRO VIDED FILE NUMBER FO R THE DATA DICTIONAR Y | |
592 | ; SUB THE LAST SUBSCRIPT IN THE NO DE ADDRESS | |
593 | ; MULT "MULTIPL E" FLAG | |
594 | N IDX,REG ,FIELDS,CN T,EXIT,RCH ,RIDX | |
595 | U 0 W:VER BOSE !,?15 ,"GETFIELD S: GET FI ELD NAMES: FILENUM= ",FILENUM ," SUBSCR IPT= ",SUB ," MULT= ",MULT | |
596 | S FIELDS= "",EXIT=0, RIDX="" | |
597 | I 'MULT D | |
598 | .F CNT=1: 1 S RIDX= $O(^DD(FIL ENUM,"GL", SUB,CNT,RI DX)) Q:EXI T D | |
599 | ..Q:(FILE NUM=741210 .14)&(SUB= 1)&(CNT=13 ) ; IF THE SPE CIFIED FIE LD # DOES NOT EXIST, CONTINUE | |
600 | ..S:RIDX= "" EXIT=1 | |
601 | ..Q:EXIT | |
602 | ..S REG=$ P(^DD(FILE NUM,RIDX,0 ),"^",1) ; GET THE FI ELD NAMES | |
603 | ..S:FIELD S'="" FIEL DS=FIELDS_ "^" | |
604 | ..S FIELD S=FIELDS_R EG | |
605 | E D | |
606 | .S:FILENU M=741210.1 47101 SUB= 0 ; 10 1 NODE IS DEFINED DI FFERENTLY | |
607 | .S RIDX=S UB ; MULTIP LE FIELDS USE SUBSCR IPTS FOR I NDEXING | |
608 | .F CNT=1: 1 S RIDX= $O(^DD(FIL ENUM,"GL", SUB,CNT,RI DX)) Q:'R IDX D | |
609 | ..S REG=$ P(^DD(FILE NUM,RIDX,0 ),"^",1) ; GET THE FI ELD NAMES | |
610 | ..S:FIELD S'="" FIEL DS=FIELDS_ "^" | |
611 | ..S FIELD S=FIELDS_R EG | |
612 | U 0 W:VER BOSE !,?15 ,"GETFIELD S: FIELD CNT= ",$L( FIELDS,"^" ) | |
613 | Q FIELDS | |
614 | ; | |
615 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; | |
616 | ; WRITEXM L() WRITES THE DATA TO THE PRO VIDED FILE AND DISPL AY | |
617 | ; (IF VER BOSE FLAG IS SET) | |
618 | ; IN ORDE R TO MAKE IT POSSIBL E TO WRITE THE DATA TO A TARGE T, THE | |
619 | ; BUFFER DESCRIPTOR CONTAINS THE IEN FO R THE BUFF ER (^CHMXC LF(1234567 )) | |
620 | ; AND SET IT TO THE VARIABLE "IDX" (^CH MXCLF(IDX) ). THIS AL LOWS THE | |
621 | ; LOAD RO UTINE TO A SSIGN A SP ECIFIC IEN FOR THE T ARGET, AND WRITE THE | |
622 | ; DATA FO R ALL NODE S TO THE T ARGETED LO CATION. | |
623 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; | |
624 | ; | |
625 | WRITEXML(G NAME,TIO,F IELDS,DATA ) | |
626 | ; GNAME THE NO DE DESCRIP TOR (I.E. ^CHMXCLF(1 234567,70, 1,0)) THAT IS BEING WRITTEN | |
627 | ; TIO TARGET IO DESTIN ATION | |
628 | ; FIELDS FIELD DESCRIPTOR S FROM THE ^DD DATA DICTIONARY | |
629 | ; DATA DATA I N THE FIEL DS | |
630 | N CNT,FNA ME,FDATA,D LEN,FLDLEN ,RCH,GNAME 1 | |
631 | S DLEN=$L (DATA,"^") | |
632 | S FLDLEN= $L(FIELDS, "^") | |
633 | S GNAME1= $$NUKEIDX( GNAME) | |
634 | U TIO W ! ,?10,"<"_G NAME1_":"_ "FIELDS="_ FLDLEN_">" ; RE PLACE THE IEN INDEX WITH THE " IEN" STRIN G | |
635 | U TIO W ! ,?15,"<FIE LDS^"_FIEL DS_">" | |
636 | U TIO W ! ,?15,"<DAT A^"_DATA_" >" | |
637 | U 0 W:VER BOSE !,"WR ITEXML: FI ELD CNT= " ,FLDLEN," <"_GNAM E1_">"," DATA= " ,DATA | |
638 | I FLDLEN= 1 D | |
639 | .S FDATA= DATA,FNAME =FIELDS | |
640 | .U 0 W:VE RBOSE !,?1 0,"WRITEXM L: <"_1_" :"_FNAME_" :"_FDATA _">" | |
641 | .U TIO W !,?15,"<"_ 1_":"_FNAM E_" :"_FD ATA_">" | |
642 | E D | |
643 | .F CNT=1: 1:FLDLEN S FNAME=$P( FIELDS,"^" ,CNT) Q: FNAME="" D ; OUTPUT T HE FIELD N AME NAMES AND DATA | |
644 | ..S FDATA =$S($P(DAT A,"^",CNT) ="":"*",1: $P(DATA,"^ ",CNT)) ; OUTPUT EAC H FIELD ON IT'S OWN LINE(NULL DATA IS "O K") | |
645 | ..U 0 W:V ERBOSE !,? 10,"WRITEX ML: <"_CN T_":"_FNAM E_" :"_FD ATA_">" | |
646 | ..U TIO W !,?15,"<" _CNT_":"_F NAME_" :" _FDATA_">" | |
647 | ;U 0 R RC H | |
648 | Q | |
649 | ; | |
650 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
651 | ; WRTXREF (NODE,TIO) WRITES TH E GLOBAL X REFS TO TH E XML FILE | |
652 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
653 | ; | |
654 | WRTXREF(BU FNAME,FNUM BER,XREF,T IO,IEN) | |
655 | ; XREF THE XR EF NODE TO BE WRITTE N | |
656 | ; TIO THE TA RGET FILE | |
657 | U 0 W:VER BOSE !,"WR ITE ",XREF | |
658 | U TIO W ! ,?15,"<"_X REF_">" | |
659 | ;U 0 R RC H | |
660 | Q | |
661 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
662 | ; NUKEIDX () (NUKE I DX) FUNCTI ON WILL RE MOVE THE A CTUAL IEN VALUE FROM THE | |
663 | ; BUFFER DATA AND R EPLACE IT WITH THE S TRING "IEN ", MAKING IT POSSIBL E | |
664 | ; TO ASSI GN THE TAR GET BUFFER INDEX (S IEN=TARGET BUFFER IN DEX) AND U SE | |
665 | ; THAT TO WRITE THE DATA TO A NEW SET O F NODES. | |
666 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
667 | ; | |
668 | NUKEIDX(GN AME) | |
669 | ; GNAME THE NA ME OF THE BUFFER TO BE MODIFIE D | |
670 | N TMP,IEN ,IENL,SUBS ,BUFFER,ST R,NGNAME | |
671 | S STR="IE N" | |
672 | S BUFFER= $P(GNAME," (",1) ; GET TH E BUFFER N AME | |
673 | S SUBS=$P (GNAME,"(" ,2) ; GET TH E ENTIRE S UBSCRIPT S TRING | |
674 | S IEN=$P( SUBS,",",1 ) ; GET TH E IEN | |
675 | S IENL=$L (IEN) ; GET THE LENGTH OF THE IEN | |
676 | S SUBS=$E (SUBS,IENL +1,$L(SUBS )) ; EXTR ACT THE IE N | |
677 | S SUBS=ST R_SUBS ; INSERT T HE "IEN" S TRING INTO SUBSCRIPT STRING | |
678 | S NGNAME= BUFFER_"(" _SUBS ; RECONS TRUCT THE GLOBAL NAM E | |
679 | Q NGNAME | |
680 | ; | |
681 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
682 | ; GETIEN( NODE) EXTR ACTS AND R ETURNS THE IEN INDEX FROM THE NODE ADDRE SS | |
683 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
684 | ; | |
685 | GETIEN(NOD E) | |
686 | ; NODE THE NO DE ADDRESS FROM WHIC H TO EXTRA CT THE IEN INDEX | |
687 | N IDX,TMP ,SIDX,EIDX ; START/ END POINTE RS FOR THE INDEX VAL UE | |
688 | I $L(NODE ,",")<2 D ; IF THE RE ARE NO "," IN THE PROVIDED NODE | |
689 | .S SIDX=$ L($P(NODE, "(",1))+2, EIDX=$L(NO DE)-1 ; USE THE ST ART AND EN D TO EXTRA CT IDX | |
690 | .S IDX=$E (NODE,SIDX ,EIDX) | |
691 | E D ; ELSE USE T HE "," DEL IMITERS | |
692 | .S TMP=$P (NODE,",", 1) | |
693 | .S IDX=$P (TMP,"(",2 ) ; EXTRAC T THE INDE X VALUE FR OM THE NOD E | |
694 | Q IDX | |
695 | ; | |
696 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
697 | ; ENDOFNO DE(IEN,NOD E) IS A BO OLEAN CHEC K FOR DETE CTING THE END OF THE | |
698 | ; CURRENT NODE BASE D ON THE I EN INDEX. IF THE IEN OF THE CU RRENT NODE | |
699 | ; DOES NO T MATCH TH E WORKING IEN, RETUR N TRUE. | |
700 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
701 | ; | |
702 | ENDOFNODE( IEN,NODE) | |
703 | ; IEN THE CU RRENT WORK ING INDEX | |
704 | ; NODE THE NO DE TO CHEC K | |
705 | S IDX=$$G ETIEN(NODE ) | |
706 | Q IDX'=IE N ; COMPARE TH E "WORKING NODE" IND EX TO THE INDEX FROM THE NODE | |
707 | ; | |
708 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
709 | ;******** ********** ********** ********** ********** ********** ********** ** | |
710 | ; THE FOL LOWING FUN CTIONS PER FORM THE D ATA EXTRAC TION TO PO PULATE THE | |
711 | ; XML FIL E. EACH FU NCTION IS SPECIFIC T O ONE CLAI M BUFFER. | |
712 | ;******** ********** ********** ********** ********** ********** ********** ** | |
713 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
714 | ; | |
715 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
716 | ; FILEBUF () CREATES THE XML O UTPUT FOR THE ^CHMXC L() BUFFER | |
717 | ; "^CHMX CL")="7412 10.04^CLAI M FILE" | |
718 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
719 | ; | |
720 | FILEBUF(ID X,HANDLE) | |
721 | ; IDX THE INDEX TO ^ CHMXCL() A SSOCIATED WITH THE C LAIM | |
722 | ; HANDLE THE FILE HANDL E FOR WRIT ING THE XM L DATA | |
723 | N GNAME,F OPENDT,EDI ARR,NAMLEN | |
724 | Q:('$D(ID X))!('$D(^ CHMXCL(IDX ))) | |
725 | S GNAME=" ^CHMXCL("_ IDX_")" | |
726 | S NAMLEN= $L(GNAME)- 1 | |
727 | D STARTEL E(GNAME,HA NDLE) ; ELEMEN T START FI ELDS FOR X ML FILE | |
728 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; DISP LAY / WRIT E GLOBAL I NFO | |
729 | Q | |
730 | ; | |
731 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
732 | ; ; TRANS ACTION BUF FER ^CHM XCLA() | |
733 | ; ^CHMXCL A = "74121 0.06^TRANS ACTION" | |
734 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
735 | ; | |
736 | TRXBUF(IDX ,HANDLE) | |
737 | ; IDX TH E ^CHMXCL( ) INDEX TO BE MOVED | |
738 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
739 | N GNAME,B ATCH,NAMLE N | |
740 | Q:('$D(ID X))!('$D(^ CHMXCLA(ID X))) | |
741 | S GNAME=" ^CHMXCLA(" _IDX_")" | |
742 | S NAMLEN= $L(GNAME)- 1 | |
743 | D STARTEL E(GNAME,HA NDLE) ; ELEMEN T START FI ELDS FOR X ML FILE | |
744 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; DISP LAYS / WRI TES GLOBAL DATA | |
745 | Q | |
746 | ; | |
747 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
748 | ; PROVIDE R BUFFER ^CHMXC LB() | |
749 | ; ^CHMXCL B = "74121 0.08^PROVI DER" | |
750 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
751 | ; | |
752 | PROVBUF(ID X,HANDLE) | |
753 | ; IDX TH E ^CHMXCLB () INDEX T O BE MOVED | |
754 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
755 | N GNAME,T BATCH,NAML EN | |
756 | Q:('$D(ID X))!('$D(^ CHMXCLB(ID X))) | |
757 | S GNAME=" ^CHMXCLB(" _IDX_")" | |
758 | S NAMLEN= $L(GNAME)- 1 | |
759 | D STARTEL E(GNAME,HA NDLE) ; EL EMENT STAR T FIELDS F OR XML FIL E | |
760 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; TEST FUNCT ION DISPLA YS ON TERM INAL | |
761 | Q | |
762 | ; | |
763 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
764 | ; PATIENT BUFFER ^CHMXC LC() | |
765 | ; ^CHMXCL C = "74121 0.1^PATIEN T" | |
766 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
767 | ; | |
768 | PATBUF(IDX ,HANDLE) | |
769 | ; IDX TH E ^CHMXCLC () INDEX T O BE MOVED | |
770 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
771 | N GNAME,P BATCH,NAML EN | |
772 | Q:('$D(ID X))!('$D(^ CHMXCLC(ID X))) | |
773 | S GNAME=" ^CHMXCLC(" _IDX_")" | |
774 | S NAMLEN= $L(GNAME)- 1 | |
775 | D STARTEL E(GNAME,HA NDLE) ; EL EMENT STAR T FIELDS F OR XML FIL E | |
776 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; DISPLAYS / WRITE XML FILE | |
777 | Q | |
778 | ; | |
779 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
780 | ; CLAIM B UFFER ^CHM XCLE() | |
781 | ; ^CHMXCL E = "74121 0.12^CLAIM " | |
782 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
783 | ; | |
784 | CLMBUF(IDX ,HANDLE) | |
785 | ; IDX THE ^CHMXCLE() INDEX TO BE MOVED | |
786 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
787 | N GNAME,B BATCH,OCRP DI,PDI,HDR CLMID,SUBC TRL,ADMITD T,PREAUTH, PCN,RECORD ,TPID,CLI, IDXSTR,NAM LEN | |
788 | Q:('$D(ID X))!('$D(^ CHMXCLE(ID X))) | |
789 | S XMLNAME ="^CHMXCLE ("_IDX_")" | |
790 | S GNAME=" ^CHMXCLE(" _IDX_",0)" | |
791 | S NAMLEN= $L(GNAME)- 1 | |
792 | U 0 W:VER BOSE !,"CL AIMBUF: G NAME= ",GN AME," NAM LEN= ",NAM LEN | |
793 | D STARTEL E(XMLNAME, HANDLE) ; ELEM ENT START FIELDS FOR XML FILE | |
794 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; TE ST FUNCTIO N DISPLAYS ON TERMIN AL | |
795 | D CLMXREF S(IDX) ; WRITE THE CLAIM BUFFER XRE FS TO THE XML FILE | |
796 | Q | |
797 | CLMXREFS(I DX) ; SET UP THE COM MON VARIAB LES TO BE USED | |
798 | S IEN=IDX ; THE CLAI M IEN INDE X (^CHMXCL F(IEN)) | |
799 | S GNAME=" ^CHMXCLE(" ; THE BUFFER NAM E | |
800 | S FILENUM =$$GETFNUM (GNAME) ; GET THE FILE N UMBER BASE D ON THE F ILE NAME | |
801 | U 0 W:VER BOSE !,?5, "LINEBUF: COMMON: I DX= ",IDX, " IEN= ", IEN," GNA ME= ",GNAM E," FILE NUMBER: ", FILENUM | |
802 | STEXREF ; WRTXREF( BUFNAME,FN UMBER,XREF ,TIO,IEN) | |
803 | U HANDLE W !,?5,"<b uffer>"_GN AME_" FILE #:"_FILEN UM_": CROS SREFERENCE : IDX="_I EN_"</buff er>" | |
804 | ENODE0 ; ^CHMXC LF("B",325 31121,8109 7092)="" ( PTR->^CHMX CLE()) | |
805 | I $D(^CHM XCLE(IEN,0 )) D | |
806 | .N CPTR,H DRID,SUBCT RL,PCN | |
807 | .S CPTR=$ P(^CHMXCLE (IEN,0),"^ ",1) ; PO INTER TO ^ CHMXCLC() | |
808 | .I CPTR'= "" D | |
809 | ..S XREF= GNAME_"""B "","_CPTR_ ",IEN)=""" "" | |
810 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO DE0: XREF= ",XREF | |
811 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
812 | .S HDRID= $P(^CHMXCL E(IEN,0)," ^",17) ; TH E 36 CHAR CLAIM ID | |
813 | .I HDRID' ="" D | |
814 | ..S XREF= GNAME_"""E "","_HDRID _",IEN)="" """ | |
815 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO DE0: XREF= ",XREF | |
816 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
817 | .S SUBCTR L=$P(^CHMX CLE(IEN,0) ,"^",14) ; SU BMITTER CO NTROL NUMB ER | |
818 | .I SUBCTR L'="" D | |
819 | ..S XREF= GNAME_"""F "","_SUBCT RL_",IEN)= """"" | |
820 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO DE0: XREF= ",XREF | |
821 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
822 | .S PCN=$P (^CHMXCLE( IDX,0),"^" ,2) ;PATIE NT CONTROL NUMBER | |
823 | .I PCN'=" " D | |
824 | .I $D(^CH MXCLE("I", PCN)) D | |
825 | ..S XREF= GNAME_"""I "","_PCN_" ,IEN)="""" " | |
826 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
827 | ENODE1 ; ADMISSIO N NODE | |
828 | I $D(^CHM XCLE(IEN,1 )) D | |
829 | .N ADMITD T | |
830 | .S ADMITD T=$P(^CHMX CLE(IDX,1) ,"^",3) ; AD MISSION DA TE | |
831 | .I (ADMIT DT'="") D | |
832 | ..S XREF= GNAME_"""G "","_ADMIT DT_",IEN)= """"" | |
833 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO DE1: XREF= ",XREF | |
834 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
835 | ENODE3 ; PRE-AUTH NODE | |
836 | I $D(^CHM XCLE(IEN,3 )) D | |
837 | .N PREAUT H,RECORD | |
838 | .S PREAUT H=$P(^CHMX CLE(IEN,3) ,"^",4) ;PRE-A UTHORIZATI ON NUMBER | |
839 | .I PREAUT H'="" D | |
840 | ..S XREF= GNAME_"""H "","_PREAU TH_",IEN)= """"" | |
841 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO DE3: XREF= ",XREF | |
842 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
843 | .S RECORD =$P(^CHMXC LE(IEN,3), "^",6) ;MEDIC AL RECORD NUMBER | |
844 | .I RECORD '="" D | |
845 | ..S XREF= GNAME_"""J "","_RECOR D_",IEN)=" """" | |
846 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO DE3: XREF= ",XREF | |
847 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
848 | ENODE100 ; ^CHMXCLE ("D",PDI,I EN) | |
849 | I $D(^CHM XCLE(IEN,1 00)) D | |
850 | .N PDI | |
851 | .S PDI=$P (^CHMXCLE( IEN,100)," ^",2) ; FI NAL PDI VA LUE ASSIGN ED (WITH L ABEL TYPE) | |
852 | .I PDI'=" " D | |
853 | ..S XREF= GNAME_"""D "","_PDI_" ,IEN)="""" " | |
854 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO DE100: XRE F= ",XREF | |
855 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
856 | NONFMAN ; THESE XR EFS ARE BU ILT BY THE EDI LOAD PROCESS | |
857 | N CLI,IDX STR ; THEY A RE NOT PAR T OF THE F ILEMAN DEF INITIONS | |
858 | S PDI=$P( ^CHMXCLE(I EN,100),"^ ",2) ; FI NAL PDI VA LUE ASSIGN ED (WITH L ABEL TYPE) | |
859 | I PDI'="" D | |
860 | .S PCN=0, PCN=$O(^CH MXCLE("PDI ",PDI,PCN) ) | |
861 | .I PCN'=" " D | |
862 | ..S CLI=0 ,CLI=$O(^C HMXCLE("PD I",PDI,PCN ,CLI)) | |
863 | ..S IDXST R="",IDXST R=$O(^CHMX CLE("PDI", PDI,PCN,CL I,IDXSTR)) | |
864 | ..S XREF= GNAME_"""P DI"","_PDI _","""_PCN _""","_CLI _","""_IDX STR_""")" | |
865 | ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER: NO N-FM: XREF = ",XREF | |
866 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
867 | .S PCN=$P (^CHMXCLE( IDX,0),"^" ,2) | |
868 | .I PCN'=" " D | |
869 | ..S CLI=0 ,CLI=$O(^C HMXCLE("CL M-CTRL-NO" ,PCN,PDI,C LI)) | |
870 | ..S IDXST R="",IDXST R=$O(^CHMX CLE("CLM-C TRL-NO",PC N,PDI,CLI, IDXSTR)) | |
871 | ..S XREF= GNAME_"""C LM-CTRL-NO "","""_PCN _""","_PDI _","_CLI_" ,"""_IDXST R_""")" | |
872 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
873 | Q | |
874 | ; | |
875 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;; | |
876 | ; LINE BU FFER ^CHM XCLF() US ES THE ^CH MXCLE() PO INTER TO E XTRACT MUL TIPLE LINE S | |
877 | ; ^CHMXCL F = "74121 0.14^SERVI CE LINE" | |
878 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;; | |
879 | ; | |
880 | LINEBUF(ID X,HANDLE) | |
881 | ; IDX THE ^CHMXCLE() POINTER T O THE ^CHM XCLF() IND EX(S) TO B E MOVED | |
882 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
883 | N GNAME,E PTR,PAYPTR ,FIDX,XMLN AME,XREF,R EVCODE,IEN ,PYRCODE | |
884 | N EXIT,JD X,KDX,SVCG RP,EI | |
885 | Q:(IDX="" ) ; EXIT IF INVALID PO INTER | |
886 | S EI=IDX ; THE ^CHM XCLE() IND EX | |
887 | U 0 W:VER BOSE !,?5, "LINEBUF: INPUT: ID X= ",IDX," HANDLE= ",HANDLE," EI= ",EI | |
888 | S FIDX=0 | |
889 | F S FIDX =$O(^CHMXC LF("B",IDX ,FIDX)) Q: FIDX="" D | |
890 | .S XMLNAM E="^CHMXCL F("_FIDX_" )" | |
891 | .S GNAME= "^CHMXCLF( "_FIDX_",0 )" | |
892 | .S NAMLEN =$L(GNAME) -1 | |
893 | .U 0 W:VE RBOSE !,"L INEBUF: G NAME= ",GN AME," NAM LEN= ",NAM LEN | |
894 | .D STARTE LE(XMLNAME ,HANDLE) ; EL EMENT STAR T FIELDS F OR XML FIL E | |
895 | .D GLBLDM P(GNAME,HA NDLE,NAMLE N) ; TE ST FUNCTIO N DISPLAYS ON TERMIN AL | |
896 | .D LINEXR EFS(EI) | |
897 | Q | |
898 | LINEXREFS( IDX) ; SET UP THE COM MON VARIAB LES TO BE USED | |
899 | S IEN=0,I EN=$O(^CHM XCLF("B",I DX,IEN)) ; THE CLAIM IEN INDEX (^CHMXCLF( IEN)) | |
900 | S GNAME=" ^CHMXCLF(" ; THE BUFFER NAM E | |
901 | S FILENUM =$$GETFNUM (GNAME) ; GET THE FILE N UMBER BASE D ON THE F ILE NAME | |
902 | U 0 W:VER BOSE !,?5, "LINEBUF: COMMON: I DX= ",IDX, " IEN= ", IEN," GNA ME= ",GNAM E," FILE NUMBER: ", FILENUM | |
903 | STARTXREF ; WRTXRE F(BUFNAME, FNUMBER,XR EF,TIO,IEN ) | |
904 | U HANDLE W !,?5,"<b uffer>"_GN AME_" FILE #:"_FILEN UM_": CROS SREFERENCE : IDX="_I EN_"</buff er>" | |
905 | FNODE0 ; ^CHMXC LF("B",325 31121,8109 7092)="" ( PTR->^CHMX CLE()) | |
906 | I $D(^CHM XCLF(IEN,0 )) D | |
907 | .S EPTR=$ P(^CHMXCLF (IEN,0),"^ ",1) ; PO INTER TO ^ CHMXCLE() | |
908 | .I EPTR'= "" D | |
909 | ..S XREF= GNAME_","" B"","_EPTR _",IEN)="" """ | |
910 | ..U 0 W:V ERBOSE !,? 5,"LINEBUF : NODE0: XREF= ",XR EF | |
911 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
912 | FNODE1 ; ^CHMXCLF ("B",9999, 81097092)= "" | |
913 | I $D(^CHM XCLF(IEN,1 )) D | |
914 | .S REVCOD E=$P(^CHMX CLF(IEN,1) ,"^",1) | |
915 | .I REVCOD E'="" D | |
916 | ..S XREF= GNAME_"""C "","_REVCO DE_",IEN)= """"" | |
917 | ..U 0 W:V ERBOSE !,? 5,"LINEBUF : NODE1: XREF= ",XR EF | |
918 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN) | |
919 | FNODE70 ; ^CHMXCLF (81097092, 70,"B","05 202",1)="" | |
920 | I $D(^CHM XCLF(IEN,7 0)) D | |
921 | .N EXIT S EXIT=0 | |
922 | .F JDX=1: 1 Q:EXIT D | |
923 | ..S:'$D(^ CHMXCLF(IE N,70,JDX,0 )) EXIT=1 | |
924 | ..Q:EXIT | |
925 | ..S PYRCO DE=$P(^CHM XCLF(IEN,7 0,JDX,0)," ^",1) | |
926 | ..I PYRCO DE'="" D | |
927 | ...S XREF =GNAME_"IE N,""B"","_ PYRCODE_", "_JDX_")=" """" | |
928 | ...U 0 W: VERBOSE !, ?5,"LINEBU F: NODE70 : XREF= ", XREF | |
929 | ...D WRTX REF(GNAME, FILENUM,XR EF,HANDLE, IEN) | |
930 | FNODE80 ; THE POINTE R TO ^CHMP AY() | |
931 | I $D(^CHM XCLF(IEN,8 0)) D | |
932 | .S PAYPTR =$P(^CHMXC LF(IEN,80) ,"^",1) ; POINTER TO ^CHMPAY() | |
933 | .I PAYPTR '="" D | |
934 | ..S XREF= GNAME_"""D "","_PAYPT R_",IEN)" | |
935 | ..U 0 W:V ERBOSE !,? 5,"LINEBUF : NODE80: XREF= ",X REF | |
936 | ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,F IDX) | |
937 | FNODE101 ; ^CHMX CLF(810970 92,70,1,10 1,"B","CO" ,1)="" | |
938 | I $D(^CHM XCLF(IEN,7 0,1,101)) D | |
939 | .N QUIT,E XITK | |
940 | .S QUIT=0 | |
941 | .F JDX=1: 1 Q:QUIT D | |
942 | ..S EXITK =0 | |
943 | ..F KDX=1 :1 Q:EXIT K D | |
944 | ...I $D(^ CHMXCLF(IE N,70,JDX,1 01,KDX,0)) D | |
945 | ....S SVC GRP=$P(^CH MXCLF(IEN, 70,JDX,101 ,KDX,0),"^ ",1) ; POIN TER TO ^CH MPAY() | |
946 | ....I SVC GRP'="" D | |
947 | .....S XR EF=GNAME_" IEN,70,"_J DX_"101,"_ """B"","_S VCGRP_","_ KDX_")=""" "" | |
948 | .....U 0 W:VERBOSE !,?5,"LINE BUF: NODE 101: XREF= ",XREF | |
949 | .....D WR TXREF(GNAM E,FILENUM, XREF,HANDL E,FIDX) | |
950 | ...I '$D( ^CHMXCLF(I EN,70,JDX, 101,KDX,0) ) S EXITK= 1 | |
951 | ...I '$D( ^CHMXCLF(I EN,70,JDX, 101)) S QU IT=1 | |
952 | Q | |
953 | ; | |
954 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
955 | ; IMAGE B UFFER ^CHM IMAGE(PDI) | |
956 | ; ^CHMIMA GE = "7410 00.1^IMAGE " | |
957 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
958 | ; | |
959 | IMAGBUF(PD I,HANDLE) | |
960 | ; PDI CLAI M PDI IS I NDEX TO ^C HMIMAGE | |
961 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
962 | N GNAME,N AMLEN | |
963 | S GNAME=" ^CHMIMAGE( "_PDI_")" | |
964 | S NAMLEN= $L(GNAME)- 1 | |
965 | D STARTEL E(GNAME,HA NDLE) ; ELEM ENT START FIELDS FOR XML FILE | |
966 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; TE ST FUNCTIO N DISPLAYS ON TERMIN AL | |
967 | I $D(^CHM IMAGE("B", PDI)) D ; SEE IF "B" XRE F IS POPUL ATED | |
968 | .S GNAME= "^CHMIMAGE (""B"","_P DI_")" | |
969 | .S NAMLEN =$L($P(GNA ME,"(",1)) | |
970 | .D GLBLDM P(GNAME,HA NDLE,NAMLE N) ; PO PULATED, S O OUTPUT X REF | |
971 | Q | |
972 | ; | |
973 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
974 | ;IMG BUFF ER ^CHMIMG (PDI) | |
975 | ; ^CHMIMG = "741000 .2^IMAGE" | |
976 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
977 | ; THE "F" XREF CONT AINS ALL O F THE BATC H->PDI REF ERENCES | |
978 | ; IT IS I MPOSSIBLE TO MOVE AL L OF THE P DIs ASSOCI ATED WITH THE | |
979 | ; BATCH F ILE FROM O NE ENVIRON MENT TO AN OTHER, SO THIS XREF IS | |
980 | ; IGNORED . | |
981 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
982 | ; S BATCH =$P(^CHMIM G(PDI,0)," ^",18) ; PO INTER TO B ATCH FILE | |
983 | ;I BATCH' ="" D | |
984 | ;.I $D(^C HMIMG("F", BATCH)) D | |
985 | ;..S GNAM E="^CHMIMG (""F"","_B ATCH_")" | |
986 | ;..D GLBL DMP(GNAME, HANDLE,NAM LEN) ; PO PULATED, S O OUTPUT X REF | |
987 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
988 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
989 | ; | |
990 | IMGBUF(PDI ,HANDLE) | |
991 | ; PDI CLAI M PDI IS I NDEX TO ^C HMIMG() | |
992 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
993 | N GNAME,N AMLEN,DOCN UM,DOCID,I MGJOB,BATC H,PDIDATE, X,VENDOR | |
994 | S GNAME=" ^CHMIMG("_ PDI_")" | |
995 | S NAMLEN= $L(GNAME)- 1 | |
996 | D STARTEL E(GNAME,HA NDLE) ; ELEM ENT START FIELDS FOR XML FILE | |
997 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; TE ST FUNCTIO N DISPLAYS ON TERMIN AL | |
998 | I $D(^CHM IMG("B",PD I)) D ; SEE IF "B" XRE F IS POPUL ATED | |
999 | .S GNAME= "^CHMIMG(" "B"","_PDI _")" | |
1000 | .S NAMLEN =$L($P(GNA ME,"(",1)) | |
1001 | .D GLBLDM P(GNAME,HA NDLE,NAMLE N) ; PO PULATED, S O OUTPUT X REF | |
1002 | S DOCNUM= $P(^CHMIMG (PDI,"DOC" ),"^",1) ; DOCUMENT N UMBER | |
1003 | I DOCNUM' ="" D | |
1004 | .I ($D(^C HMIMG("D", PDI))) D ; SEE IF " D" XREF IS POPULATED | |
1005 | ..S GNAME ="^CHMIMG( ""D"","_DO CNUM_")" | |
1006 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) ; PO PULATED, S O OUTPUT X REF | |
1007 | S DOCID=$ P(^CHMIMG( PDI,"DOC") ,"^",10) ; MANUAL DOC UMENT ID | |
1008 | I DOCID'= "" D | |
1009 | .I ($D(^C HMIMG("E", DOCID))) D | |
1010 | ..S GNAME ="^CHMIMG( ""E"","_DO CID_")" | |
1011 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) ; PO PULATED, S O OUTPUT X REF | |
1012 | S IMGJOB= $P(^CHMIMG (PDI,"TRAC K"),"^",7) ; IMAGE JOB TYPE | |
1013 | I IMGJOB' ="" D | |
1014 | .I $D(^CH MIMG("G",I MGJOB)) D | |
1015 | ..S GNAME ="^CHMIMG( ""G"","_IM GJOB_")" | |
1016 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) ; PO PULATED, S O OUTPUT X REF | |
1017 | S PDIDATE =$P(^CHMIM G(PDI,0)," ^",21) ; DATE PDI C REATED | |
1018 | I PDIDATE '="" D | |
1019 | .I $D(^CH MIMG("AD", PDIDATE)) D | |
1020 | ..S GNAME ="^CHMIMG( ""AD"","_P DIDATE_")" | |
1021 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) ; PO PULATED, S O OUTPUT X REF | |
1022 | S VENDOR= $P(^CHMIMG (PDI,"TRAC K"),"^",3) ; SUBMISSION VENDOR | |
1023 | I VENDOR' ="" D | |
1024 | .I $D(^CH MIMG("AU", VENDOR)) D | |
1025 | ..S GNAME ="^CHMIMG( ""AU"","_V ENDOR_")" | |
1026 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) ; PO PULATED, S O OUTPUT X REF | |
1027 | ;D ENDELE (GNAME,HAN DLE) ; ELEM ENT CLOSE FIELDS FOR XML FILE | |
1028 | Q | |
1029 | ; | |
1030 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
1031 | ; PAY BUF FER ^CHM PAY() | |
1032 | ; ^CHMPAY = "741000 ^PAYMENT" | |
1033 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
1034 | ; | |
1035 | PAYBUF(EID X,HANDLE) | |
1036 | ; EIDX "I" INDEX FOR THE ^CHMED I() FILE ( MAY CONTAI N MORE THA N 1 ^CHMPA Y() NODE) | |
1037 | ; HANDLE THE FILE HANDL E TO WRITE THE XML F ILE | |
1038 | N GNAME,H ACCLM,PDI, SPNSR,CMPL TDT,VENDOR ID,NAMLEN, JIDX,PAYI, IDX | |
1039 | S JIDX=0 | |
1040 | F S JIDX =$O(^CHMED I(EIDX,1,J IDX)) Q:JI DX="" D | |
1041 | .S PAYI=$ P(^CHMEDI( EIDX,1,JID X,0),"^",1 ) ; RE TRIEVE ALL ASSOCIATE D PAY FILE NODES | |
1042 | .S GNAME= "^CHMPAY(" _PAYI_")" | |
1043 | .S NAMLEN =$L(GNAME) -1 | |
1044 | .D STARTE LE(GNAME,H ANDLE) ; START ELEMENTS F OR THE XML FILE | |
1045 | .D GLBLDM P(GNAME,HA NDLE,NAMLE N) ; TEST FUNCTION DISPLAYS O N TERMINAL | |
1046 | .S GNAME= "^CHMPAY(" | |
1047 | .S NAMLEN =$L($P(GNA ME,"(",1)) | |
1048 | .S IDX=PA YI ; SETUP TH E "I" INDE X FOR ^CHM PAY() | |
1049 | .S HACCLM =$P(^CHMPA Y(IDX,0)," ^",1) ; PREP FOR "B" X REF | |
1050 | .I HACCLM '="" D | |
1051 | ..I $D(^C HMPAY("B", HACCLM)) D | |
1052 | ...S GNAM E="^CHMPAY (""B"",""" _HACCLM_"" ")" ; HA C CLAIM # XREF | |
1053 | ...D GLBL DMP(GNAME, HANDLE,NAM LEN) | |
1054 | .S PDI=$P ($P(^CHMPA Y(IDX,0)," ^",4),"*", 1) | |
1055 | .I PDI'=" " D | |
1056 | ..I $D(^C HMPAY("C", PDI)) D ; PDI XREFS | |
1057 | ...S GNAM E="^CHMPAY (""C"","_P DI_")" | |
1058 | ...D GLBL DMP(GNAME, HANDLE,NAM LEN) | |
1059 | .S SPONSO R=$P(^CHMP AY(IDX,0), "^",21) ; SP ONSOR POIN TER TO ^AH CHVA() | |
1060 | .I SPONSO R '="" D | |
1061 | ..I $D(^C HMPAY("D", SPONSOR,ID X)) D | |
1062 | ...S GNAM E="^CHMPAY (""D"","_S PONSOR_"," _IDX_")" ; ONLY INTE RESTED IN THIS CLAIM | |
1063 | ...D GLBL DMP(GNAME, HANDLE,NAM LEN) | |
1064 | .S CMPLTD T=$P(^CHMP AY(IDX,0), "^",10) ; DA TE DETERMI NED COMPLE TE | |
1065 | .I CMPLTD T'="" D | |
1066 | ..I $D(^C HMPAY("E", CMPLTDT)) D | |
1067 | ...S GNAM E="^CHMPAY (""E"","_C MPLTDT_")" | |
1068 | ...D GLBL DMP(GNAME, HANDLE,NAM LEN) | |
1069 | .S VENDOR ID=$P(^CHM PAY(IDX,0) ,"^",3) ; VE NDOR ID | |
1070 | .I VENDOR ID'="" D | |
1071 | ..I $D(^C HMPAY("AD" ,VENDORID) ) D | |
1072 | ...S GNAM E="^CHMPAY (""AD"","_ VENDORID_" ,"_IDX_")" ; ON LY INTERES TED IN XRE F FOR THIS CLAIM IND EX | |
1073 | ...D GLBL DMP(GNAME, HANDLE,NAM LEN) ; DISPLAYS / WRITES XML FILE | |
1074 | Q | |
1075 | ; | |
1076 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1077 | ; CHMPAY (WORK FILE ) ^CHMPAYW () | |
1078 | ; ^CHMPAY W = "74100 2.602^WORK FLOW" | |
1079 | ; THIS FI LE UTILIZE S NO CROSS REFERENCES , SO FUNCT ION JUST O UTPUTS THE ENTRIES | |
1080 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1081 | ; | |
1082 | PAYWRK(IDX ,HANDLE) | |
1083 | ; IDX "I" INDEX FOR THE CLAIM IN ^CHMPAY W() | |
1084 | ; HANDLE FIEL HANDLE FO R THE XML FILE | |
1085 | N GNAME,F MSDOCID,PA YPTR,STATU S,CHECK,ST AT277,FILE NUM,BERRDT ,NAMLEN | |
1086 | S GNAME=" ^CHMPAYW(" _IDX_")" | |
1087 | S NAMLEN= $L(GNAME)- 1 | |
1088 | D STARTEL E(GNAME,HA NDLE) ; STAR T ELEMENT FOR XML FI LE | |
1089 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; DI SPLAYS / W RITES XML FILE | |
1090 | Q | |
1091 | ; | |
1092 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1093 | ; EDI BUF FER ^CHM EDI() | |
1094 | ; ^CHMEDI = "741207 .01^835 ST ATUS" | |
1095 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1096 | ; | |
1097 | EDIBUF(IDX ,HANDLE) | |
1098 | ; IDX "I" INDEX FOR THE CLAIM IN ^CHMPAY () | |
1099 | ; HANDLE FIEL HANDLE FO R THE XML FILE | |
1100 | N GNAME,F MSDOCID,PA YPTR,STATU S,CHECK,ST AT277,FILE NUM,BERRDT ,NAMLEN | |
1101 | S GNAME=" ^CHMEDI("_ IDX_")" | |
1102 | S NAMLEN= $L(GNAME)- 1 | |
1103 | D STARTEL E(GNAME,HA NDLE) ; STAR T ELEMENT FOR XML FI LE | |
1104 | D GLBLDMP (GNAME,HAN DLE,NAMLEN ) ; DI SPLAYS / W RITES XML FILE | |
1105 | S GNAME=" ^CHMEDI(" | |
1106 | S NAMLEN= $L($P(GNAM E,"(",1)) | |
1107 | S FMSDOCI D=$P(^CHME DI(IDX,0), "^",1) ; PREP FOR " B" XREF | |
1108 | I FMSDOCI D'="" D | |
1109 | .I $D(^CH MEDI("B",F MSDOCID)) D | |
1110 | ..S GNAME ="^CHMEDI( ""B"","""_ FMSDOCID_" "")" ; FMS DOC ID / RECONCIL IATION NUM BER | |
1111 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) | |
1112 | S PAYPTR= $P(^CHMEDI (IDX,1,1,0 ),"^",1) ; PREP FOR " B" XREF | |
1113 | I PAYPTR' ="" D | |
1114 | .I $D(^CH MEDI("C",P AYPTR)) D | |
1115 | ..S GNAME ="^CHMEDI( ""C"","_PA YPTR_")" ; ^CHMPAY PO INTER(S) | |
1116 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) | |
1117 | S STATUS= $P(^CHMEDI (IDX,0),"^ ",2) ; ST ATUS XREF | |
1118 | I STATUS' ="" D | |
1119 | .I $D(^CH MEDI("D",S TATUS,IDX) ) D ; VE RIFY THERE IS A STAT US XREF | |
1120 | ..S GNAME ="^CHMEDI( ""D"","_ST ATUS_","_I DX_")" ; SET THE ST ATUS XREF | |
1121 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) | |
1122 | S CHECK=$ P(^CHMEDI( IDX,0),"^" ,3) ; CH ECK NUMBER XREF | |
1123 | I CHECK'= "" D | |
1124 | .I $D(^CH MEDI("E",C HECK)) D | |
1125 | ..S GNAME ="^CHMEDI( ""E"","_CH ECK_")" | |
1126 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) | |
1127 | S STAT277 =$P(^CHMED I(IDX,1,1, 0),"^",2) ; 277 STATUS XREF | |
1128 | I STAT277 '="" D | |
1129 | .I $D(^CH MEDI("F",S TAT277,IDX )) D | |
1130 | ..S GNAME ="^CHMEDI( ""F"","_ST AT277_","_ IDX_")" | |
1131 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) | |
1132 | S FILENUM =$P(^CHMED I(IDX,0)," ^",6) ; CH ECK NUMBER XREF | |
1133 | I FILENUM '="" D | |
1134 | .I $D(^CH MEDI("G",F ILENUM)) D | |
1135 | ..S GNAME ="^CHMEDI( ""G"","_FI LENUM_")" | |
1136 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) | |
1137 | S BERRDT= $P(^CHMEDI (IDX,0),"^ ",7) ; BA LANCE ERRO R DATE XRE F | |
1138 | I BERRDT' ="" D | |
1139 | .I $D(^CH MEDI("H",B ERRDT)) D | |
1140 | ..S GNAME ="^CHMEDI( ""H"","_BE RRDT_")" | |
1141 | ..D GLBLD MP(GNAME,H ANDLE,NAML EN) | |
1142 | Q | |
1143 | ; | |
1144 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;; | |
1145 | ;******** ********** ********** ********** ********** ********** ********** *** | |
1146 | ; THE FIL LOWING FUN CTIONS ARE GENERIC, I.E. THEY PROVIDE CA PABILITIES | |
1147 | ; THAT AR E NOT UNIQ UELY TAILO RED TO GEN ERATING TH E XML FILE FOR THE | |
1148 | ; CLAIM B UFFERS. | |
1149 | ;******** ********** ********** ********** ********** ********** ********** *** | |
1150 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;; | |
1151 | ; | |
1152 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1153 | ; $$GETPD ITYP(PDI) RETURNS A TEXT DESCR IPTION OF THE CLAIM TYPE | |
1154 | ; (CHAMPV A/SXC/MEDC OB, ETC.) | |
1155 | ; W $$GET PDITYP(201 3225910387 83) 91: X 12 (MED) E DI | |
1156 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1157 | ; | |
1158 | GETPDITYP( PDI) | |
1159 | ; PDI PDI TO REPORT CLAIM TYPE | |
1160 | N CTYPE | |
1161 | S CTYPE=$ E(PDI,8,9) | |
1162 | Q:CTYPE=" 00" "00: U NASSIGNED" | |
1163 | Q:CTYPE=" 02" "02: C HK REISSUE " | |
1164 | Q:CTYPE=" 03" "03: O CR (PAPER) " | |
1165 | Q:CTYPE=" 04" "04: C ITI" | |
1166 | Q:CTYPE=" 05" "05: P RICO" | |
1167 | Q:CTYPE=" 06" "06: R E-OPEN" | |
1168 | Q:CTYPE=" 07" "07: W ALK-THRU" | |
1169 | Q:CTYPE=" 08" "08: C VAF" | |
1170 | Q:CTYPE=" 09" "09: P GULF" | |
1171 | Q:CTYPE=" 10" "10: F MP" | |
1172 | Q:CTYPE=" 91" "91: M EDCOB EDI" | |
1173 | Q:CTYPE=" 92" "92: S B EDI" | |
1174 | Q:CTYPE=" 93" "93: C WVV EDI" | |
1175 | Q:CTYPE=" 98" "98: C MOP RXT" | |
1176 | Q:CTYPE=" 99" "99: R X EDI" | |
1177 | Q "OTHER (PAPER/OCR )" | |
1178 | ; | |
1179 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; | |
1180 | ; PAYI2TY P() USES T HE ^CHMPAY (PAYI,"ZEM C") XREF T O RETRIEVE CLAIM TYP E (ENV/MED COB/SXC/et c.) | |
1181 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; | |
1182 | ; | |
1183 | PAYI2TYP(P AYI) | |
1184 | ; PAYI "I" INDEX FOR THE ^CHMPA Y FILE | |
1185 | N CLMTYP, CHTPID ; VARIAB LES TO RET RIEVE THE CLAIM TYPE FROM ^CHM PAY(PAYI," ZEMC" XREF | |
1186 | S CLMTYP= "NO ZEMC" | |
1187 | Q:'$D(^CH MPAY(PAYI, "ZEMC")) C LMTYP | |
1188 | S CHTPID= 0,CHTPID=$ O(^CHMPAY( PAYI,"ZEMC ",CHTPID)) | |
1189 | Q:CHTPID= "" CLMTYP | |
1190 | S:CHTPID= "SXC" CLMT YP="SXC PH ARMACY" | |
1191 | S:CHTPID= "ENV" CLMT YP="EMDEON X12" | |
1192 | S:CHTPID= "MEDCOB" C LMTYP="MED ICARE CROS SOVER" | |
1193 | Q CLMTYP ; RETU RN THE "LO NG" VERSIO N OF THE C LAIM TYPE | |
1194 | ; | |
1195 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
1196 | ; CONVERT THE YYYYM MDD DATE S TRING TO M M-DD-YYYY FORMAT | |
1197 | ; W $$DTC VRT(201403 08) -> 03 -08-2014 | |
1198 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
1199 | ; | |
1200 | DTCVRT(DAT E) | |
1201 | N EXTDATE | |
1202 | S EXTDATE =$E(DATE,5 ,6)_"-"_$E (DATE,7,8) _"-"_$E(DA TE,1,4) | |
1203 | Q EXTDATE | |
1204 | ; | |
1205 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;; | |
1206 | ;******** ********** ********** ********** ********** ********** ********** ***** | |
1207 | ; THE FOL LOWING FUN CTIONS ARE TESTING F UNCTIONS U SED TO PER FORM OR VE RIFY | |
1208 | ; UNIT TE STING. | |
1209 | ;******** ********** ********** ********** ********** ********** ********** ***** | |
1210 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;; | |
1211 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;; | |
1212 | ; NODEDUM P(NODE) US ES THE $QU ERY TO DIS PLAY POPUL ATED SUBNO DES TO THE | |
1213 | ; SPECIFI ED NODE. | |
1214 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;; | |
1215 | ; | |
1216 | NODEDUMP(N ODE) | |
1217 | ; NODE THE STARTING N ODE FOR TH E DISPLAY | |
1218 | N REF,IEN ,NIEN,EXIT | |
1219 | S IEN=$$G ETIEN(NODE ) ; GET THE IE N INDEX FR OM THE GLO BAL | |
1220 | S REF=NOD E,EXIT=0 | |
1221 | F Q:EXIT S REF=$Q (@REF) D ; JUST DIS PLAY THE S PECIFIED N ODE SUBNOD ES | |
1222 | .I $$ENDO FNODE(IEN, REF) D Q | |
1223 | ..S EXIT= 1 | |
1224 | .U 0 W !, REF,"= ",@ REF | |
1225 | Q | |
1226 | ||
1227 | ||
1228 | ||
1229 | ||
1230 | ||
1231 | ||
1232 | ||
1233 | ||
1234 | ||
1235 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1236 | ; GETIDX EXTRACTS T HE NODE IN DEX FROM T HE GNAME V ARIABLE | |
1237 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1238 | ; | |
1239 | GETIDX(GNA ME) | |
1240 | ; GNAME ; GLOB AL NAME AN D NODE NOD E INDEX CO MBINATION | |
1241 | N SIDX,EI DX,IDX ; ST ART/END PO INTERS FOR THE INDEX VALUE | |
1242 | S SIDX=$L ($P(GNAME, "(",1))+2, EIDX=$L(GN AME)-1 | |
1243 | S IDX=$E( GNAME,SIDX ,EIDX) | |
1244 | U 0 W:VER BOSE !,"GE TIDX: IDX= ",IDX | |
1245 | Q IDX ; RETU RN THE IND EX VALUE | |
1246 | ; | |
1247 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1248 | ; ISXREF( ) BOOLEAN TEST FOR T HE GNAME B EING A CRO SS-REFEREN CE | |
1249 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; | |
1250 | ; | |
1251 | NOTXREF(GN AME) | |
1252 | ; GNAME ; GLOB AL NAME AN D NODE NOD E INDEX CO MBINATION | |
1253 | N SIDX,EI DX,IDX ; ST ART/END PO INTERS FOR THE INDEX VALUE | |
1254 | S SIDX=$L ($P(GNAME, "(",1))+2, EIDX=$L($P (GNAME,"," ,1))-1 | |
1255 | S IDX=$E( GNAME,SIDX ,EIDX) | |
1256 | Q IDX?1N. N ; RETU RN TRUE IF IDX VALUE IS NUMERI C | |
1257 | ; | |
1258 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;; | |
1259 | ; CHKMULT () IS A BO OLEAN CHEC K ON THE P ROVIDED NO DE TO DETE RMINE | |
1260 | ; IF THE NODE IS A "MULTIPLE" MARKER | |
1261 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; | |
1262 | ; | |
1263 | CHKMULT(NO DE,SUB) | |
1264 | ; NODE THE GLOBAL NOD E TO BE CH ECKED | |
1265 | N DVAL,FI LENUM,MFIL ENUM,RETUR N | |
1266 | S RETURN= 0 ; DEFAULT RETURN IS NON-MULTIP LE | |
1267 | S DVAL=$D (@NODE) ; CHECK TO SEE IF THE NODE I S POPULATE D | |
1268 | U 0 W:VER BOSE !,?5, "CHKMULT: $D(@NODE) = ",DVAL | |
1269 | I DVAL#10 D ; IF THE NODE CONT AINS DATA | |
1270 | .S FILENU M=$$GETFNU M(NODE) ; GET THE BASE F ILE NUMBER FOR THE G LOBAL | |
1271 | .S MFILEN UM=$P(@NOD E,"^",2) ; GE T THE FILE NUMBER FR OM THE NOD E | |
1272 | .S:MFILEN UM[FILENUM RETURN=MF ILENUM ; IF THE NOD E CONTAINS EXTENDED FILE NUMBE R | |
1273 | .U 0 W:VE RBOSE !,?5 ,"CHKMULT: FILENUM= ",FILENUM ," MFILEN UM= ",MFIL ENUM," TS T= ",MFILE NUM[FILENU M | |
1274 | Q RETURN ; RETURN T HE "MULTIP LE" FILE N UMBER | |
1275 | ; | |
1276 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
1277 | ; SUBTREE () RETRIEV ES THE SUC CESSIVE NO DES FOR TH E SUBTREE DEFINED BY "NODE" | |
1278 | ; FOR "MU LTIPLE" NO DES | |
1279 | ; EXAMPLE CALL: D SUBTREE("C HMXCLF(810 97092,70)" ) | |
1280 | ; THE SUB TREE WILL RETURN THE NEXT NODE IN THE SU BTREE FOR THE PROVID ED NODE | |
1281 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;; | |
1282 | ; | |
1283 | SUBTREE(GN ODE,SUB) ; RETURN TH E NEXT SUB TREES OF T HE PROVIDE D GLOBAL @ THE "I" I NDEX | |
1284 | ; GNODE NAME OF THE DE SIRED GLOB AL (FILENA ME AND THE "I" INDEX : "^CHMPAY (12345678) " | |
1285 | ; SUB THE CURRENT SU BSCRIPT | |
1286 | N DATA,SU B1,SUBLEN, XREF,RNAME ,FILENUM,E XIT,MULT | |
1287 | S XREF=0, RNAME="",E XIT=0 | |
1288 | U 0 W:VER BOSE !,?10 ,"SUBTREE ENTRY: NOD E= ",NODE, " SUBSCRI PT= ",SUB | |
1289 | S MULT=$$ CHKMULT(NO DE) | |
1290 | U 0 W !,? 10,"SUBTRE E: CHECK NODE: ",NO DE," MULTI PLE = **** *",$S(MULT =1:"TRUE", 1:"FALSE") ,"*****" | |
1291 | S SUBLEN= $L(SUB) | |
1292 | F Q:EXIT D | |
1293 | .S SUB1=$ O(@GNODE) | |
1294 | .I (MULT) !((SUB1'=" ")&(SUB1'? 1A)) D | |
1295 | ..U 0 W:V ERBOSE !,? 10,"SUBTRE E: SUB1=$ O(@GNODE)= ",SUB1 | |
1296 | ..S GNODE =($E(GNODE ,1,$L(GNOD E)-(SUBLEN +1))_SUB1_ ")") ; CRE ATE THE NE XT NODE AD DRESS | |
1297 | ..U 0 W:V ERBOSE !,? 10,"SUBTRE E: $O(@GN ODE) UPDAT ED NODE= " ,GNODE," $D(@GNODE) = ",$D(@GN ODE) | |
1298 | ..S EXIT= 1 | |
1299 | .E D | |
1300 | ..S SUB=" " | |
1301 | ..S SUB=$ O(@GNODE@( SUB)) ; GET THE NE XT SUBSCRI PT VALUE | |
1302 | ..U 0 W:V ERBOSE !,? 10,"SUBTRE E: $O(@GNO DE@(SUB) S UB= ",SUB | |
1303 | ..I (SUB' ="") D ; &(SU B'?1A) | |
1304 | ...I GNOD E?.E1")" S GNODE=($E (GNODE,1,$ L(GNODE)-1 )_","_$S(S UB?1N.N:SU B,1:""""_S UB_"""")_" )") ; CREA TE THE NEX T NODE ADD RESS | |
1305 | ...E S G NODE=(GNOD E_"("_$S(S UB?1N.N:SU B,1:""""_S UB_"""")_" )") | |
1306 | ..S EXIT= 1 | |
1307 | ..U 0 W:V ERBOSE !,? 10,"SUBTRE E: $O(@GN ODE@(SUB)) UPDATED N ODE= ",GNO DE," $D(@ GNODE)= ", $D(@GNODE) | |
1308 | Q GNODE | |
1309 | ; | |
1310 | ; | |
1311 | SUBTST() | |
1312 | N NODE,SU BS,XIT,SUB V,TMP,FILE NUM,MULTIP LE | |
1313 | S NODE="^ CHMXCLF(81 097092,70) ",SUBV="", XIT=0 | |
1314 | F Q:XIT D | |
1315 | .U 0 W !, ?5,"SUBTST : GET NEX T NODE FOL LOWING ",N ODE | |
1316 | .S NODE=$ $SUBTREEQ( NODE,SUBV) | |
1317 | .U 0 W !, ?5,"SUBTST : ",?60," SUBTREE RE TURNED: ** *** ",NOD E," ***** " | |
1318 | .S SUBS=$ L(NODE,"," ) | |
1319 | .S TMP=$P (NODE,")", 1) | |
1320 | .S SUBV=$ P(TMP,",", SUBS) | |
1321 | .U 0 W !? 5,"SUBTST: NEW SUBV= ",SUBV | |
1322 | .R RCH | |
1323 | .S:(RCH=" Q")!(RCH=" q") XIT=1 | |
1324 | Q | |
1325 | ; | |
1326 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
1327 | ; SUBTREE Q(NODE) U SES THE QU ERY COMMAN D TO RETRI EVE THE NE XT | |
1328 | ; SUBNODE OF THE GL OBAL | |
1329 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; | |
1330 | ; | |
1331 | SUBTREEQ(N ODE,SUB) | |
1332 | N NODE1 | |
1333 | S NODE1=$ Q(@NODE) | |
1334 | Q NODE1 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.