Produced by Araxis Merge on 11/9/2018 12:33:53 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 | CHMCRZC7.m | Mon Nov 5 16:42:47 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMCRZC7.m | Mon Nov 5 17:43:18 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 1028 |
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 | CHMCRZC7 ; JAH/CEP - A28/A31 MS G Builder CP&E Spons ors ; 5/6/ 13 4:08pm | |
2 | ;;1.3;CHA MPVA;**225 28**;;Buil d 17 | |
3 | ;**22528 - JAH/CEP | |
4 | ; | |
5 | Q | |
6 | ; | |
7 | GENACTPR(R ETURN,BILL NUM) ; gen erate acco unt profil e | |
8 | ; | |
9 | ;EXAMPLE: | |
10 | ; D G ENACTPR^CH MCRZ02(.RE TURN,"K400 S4Q",1) | |
11 | ; r un account profile r eport to h ost file a nd read ba ck into gl obal | |
12 | N ERRORS, CHRAWD,BIL LIEN,HFSDI R,FILENAME ,POP | |
13 | ; | |
14 | S RETURN= $NA(^TMP(" CHMCR ACCO UNT",$J)) | |
15 | K @RETURN | |
16 | S CHRAWD= $NA(^TMP(" CHMCR RAW ACCOUNT",$ J)) | |
17 | K @CHRAWD | |
18 | ; | |
19 | D CHKBILL ^CHMCRUT3( .ERRORS,.B ILLIEN,BIL LNUM) | |
20 | ;If error s found XM Lize error s and quit | |
21 | I +$G(ERR ORS(0))>0 D Q | |
22 | . D GEOB XML^CHMCRC 31(.RETURN ,"",.ERROR S) | |
23 | ; | |
24 | ; Open Ho st File fo r Output o f EOB repo rt | |
25 | ; | |
26 | ; sample EOB tempor ary HFS Fi le Directo ry USER$:[ TEMP] | |
27 | ; CHMCR_EOB_ 111334533_ 542069954_ 52013.DAT; 1 | |
28 | ; | |
29 | S HFSDIR= $$DEFDIR^% ZISH() | |
30 | S FILENAM E="CHMCR_A CCOUNT_"_B ILLIEN_"_" _$J_"_"_$P ($H,",",2) _".DAT" | |
31 | ; | |
32 | ; set EOF handling for Kernel calls to | |
33 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
34 | ; | |
35 | D OPEN^%Z ISH("WRITE FILE",HFSD IR,FILENAM E,"W") | |
36 | ; | |
37 | ;If can't open file for writi ng get xml error mes sage and q uit | |
38 | ; | |
39 | D CHKPOP^ CHMCRUT1(. ERRORS,POP ,"W") | |
40 | ; | |
41 | I +$G(ERR ORS(0))>0 D Q | |
42 | . D CLOS E^%ZISH("W RITEFILE") | |
43 | . D CLEA N(FILENAME ,HFSDIR) | |
44 | . D GEOB XML^CHMCRC 31(.RETURN ,"",.ERROR S) | |
45 | ; | |
46 | ; set TMP for call to run EOB that look s there fo r claim ie n (CLAIMIE N) | |
47 | ; and typ e provider or benefi ciary (PRO VIDER) | |
48 | ; | |
49 | U IO | |
50 | S D0=BILL IEN ;NEE DED FOR EN TRY POINT | |
51 | D PROC^PR CAPRO | |
52 | ;D INDIVI ^CHMG430 | |
53 | D CLOSE^% ZISH("WRIT EFILE") | |
54 | ; | |
55 | ; this is clean up for extern al call to EOB Repor t in INDIV ^CHMG430 | |
56 | ;K ^TMP($ J,"ACCOUNT ") | |
57 | ; | |
58 | ; Read fi le back in to a globa l | |
59 | ; | |
60 | K POP | |
61 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
62 | D OPEN^%Z ISH("READF ILE",HFSDI R,FILENAME ,"R") | |
63 | ; | |
64 | ;If can't open file for writi ne get xml error mes sage and q uit | |
65 | ; | |
66 | D CHKPOP^ CHMCRUT1(. ERRORS,POP ,"R") | |
67 | ; | |
68 | I +$G(ERR ORS(0))>0 D Q | |
69 | . D CLOS E^%ZISH("R EADFILE") | |
70 | . D CLEA N(FILENAME ,HFSDIR) | |
71 | . D GEOB XML^CHMCRC 31(.RETURN ,"",.ERROR S) | |
72 | ; | |
73 | N I,X | |
74 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
75 | U IO F I= 1:1 R X:DT IME Q:$$ST ATUS^%ZISH () S @CHR AWD@("repo rt",I)=X | |
76 | D CLOSE^% ZISH("READ FILE") | |
77 | ; | |
78 | D GEOBXML ^CHMCRC31( .RETURN,.C HRAWD,.ERR ORS) ; NO CUST AR RAY | |
79 | ; | |
80 | ; destroy ^TMP glob als | |
81 | ; | |
82 | K @CHRAWD | |
83 | D CLEAN(F ILENAME,HF SDIR) | |
84 | ; | |
85 | Q | |
86 | CLEAN(FILE NAME,HFSDI R) ; | |
87 | ; destroy readfile | |
88 | ; | |
89 | N Y,FILES PEC | |
90 | S FILESPE C(FILENAME )="" | |
91 | S Y=$$DEL ^%ZISH(HFS DIR,$NA(FI LESPEC)) | |
92 | Q | |
93 | FMPCLMHI(R ETURN,CHDF N,CHBDATE, CHEDATE) ; | |
94 | ; FMP CLA IM HISTORY | |
95 | ;INPUT: C HDFN | |
96 | ; - SHOULD ADD BEGIN DAT E, END DAT E | |
97 | ;OUTPUT: NOTHIN YET . | |
98 | ; | |
99 | ;TODO: CA LL INPUT C HECK, GET RID OF QUI TS | |
100 | N ERRORS | |
101 | ; | |
102 | ;TODO: ne w rawd aft er testing is done | |
103 | ;N CHRAWD | |
104 | ; | |
105 | S RETURN= $NA(^TMP(" CHMCR CLAI M HISTORY" ,$J)) | |
106 | K @RETURN | |
107 | S CHRAWD= $NA(^TMP(" CHMCR RAW CLAIM HIST ORY",$J)) | |
108 | K @CHRAWD | |
109 | ; | |
110 | ;TODO: de al with da te format (convert t o fileman dates) | |
111 | S CHBDATE =$G(CHBDAT E) | |
112 | S CHEDATE =$G(CHEDAT E) | |
113 | ; | |
114 | S CHFIO=" " | |
115 | ;S CHFIO= $G(ION) | |
116 | S CHZN=$G (^AHCHVA(C HDFN,0)) Q :CHZN="" | |
117 | S CHFLNM= $P(CHZN,U, 1) Q:CHFLN M="" | |
118 | S CHVET=C HFLNM | |
119 | S CHSSN=$ P(CHZN,U,9 ) Q:CHSSN= "" | |
120 | I CHSSN'= "" D | |
121 | . S CHSS N=$E(CHSSN ,1,3)_"-"_ $E(CHSSN,4 ,5)_"-"_$E (CHSSN,6,9 ) ;CALL HAS TO HAV E CHSSN FO RMATTED | |
122 | I CHEDATE ="" D | |
123 | . D NOW^ %DTC | |
124 | . S CHED ATE=$E(%,1 ,7) ;END DATE - COULD AD D TO PARAM S | |
125 | S CHBDATE ="" ;NO BEGIN DATE - COU LD ADD TO PARAMS | |
126 | S CHPRINT =0 | |
127 | S CHVIEW= 1 | |
128 | S CHCOUNT =0 | |
129 | ;;CODE CO PY FROM EO BHFS CALL | |
130 | ;;NOT SUR E WHAT COD E TO COPY :-/ | |
131 | ; | |
132 | N HFSDIR, FILENAME,P OP | |
133 | S HFSDIR= $$DEFDIR^% ZISH() | |
134 | S FILENAM E="CHMCR_C LM_HIST_"_ $J_"_"_$P( $H,",",2)_ ".DAT" | |
135 | ; | |
136 | ; set EOF handling for Kernel calls to | |
137 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
138 | ; | |
139 | D OPEN^%Z ISH("WRITE FILE",HFSD IR,FILENAM E,"W") | |
140 | ; | |
141 | ;If can't open file for writi ng get xml error mes sage and q uit | |
142 | ; | |
143 | D CHKPOP^ CHMCRUT1(. ERRORS,POP ,"W") | |
144 | ; | |
145 | ; | |
146 | I +$G(ERR ORS(0))>0 D Q | |
147 | . D CLOS E^%ZISH("W RITEFILE") | |
148 | . D CLEA N(FILENAME ,HFSDIR) | |
149 | .;TODO ER ROR PROCES SING FOR C LAIM HISTO RY | |
150 | .; D GEO BXML^CHMCR C31(.RETUR N,"",.ERRO RS) | |
151 | ; | |
152 | W !,"JUST PRIOR WRI TING TO FI LE, AFTER OPEN FILE" ,!," ",HF SDIR,FILEN AME,!! | |
153 | S CHVIEW= 1 | |
154 | U IO | |
155 | D CALC^CH FMPR6C | |
156 | D PRINT^C HFMPR6P | |
157 | ; | |
158 | D CLOSE^% ZISH("WRIT EFILE") | |
159 | ; | |
160 | ; TODO: d oes anythi ng need cl ean up fro m report? | |
161 | ; K ^TMP ($J,"EOB") | |
162 | ; | |
163 | ; Read fi le back in to a globa l | |
164 | ; | |
165 | K POP | |
166 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
167 | D OPEN^%Z ISH("READF ILE",HFSDI R,FILENAME ,"R") | |
168 | ; | |
169 | ;If can't open file for writi ne get xml error mes sage and q uit | |
170 | ; | |
171 | D CHKPOP^ CHMCRUT1(. ERRORS,POP ,"R") | |
172 | ; | |
173 | I +$G(ERR ORS(0))>0 D Q | |
174 | . D CLOS E^%ZISH("R EADFILE") | |
175 | . D CLEA N(FILENAME ,HFSDIR) | |
176 | .; return claim his tory error s | |
177 | .; D GEO BXML^CHMCR C31(.RETUR N,"",.ERRO RS) | |
178 | ; | |
179 | N I,X | |
180 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
181 | U IO F I= 1:1 R X:DT IME Q:$$ST ATUS^%ZISH () S @CHR AWD@("repo rt",I)=X | |
182 | D CLOSE^% ZISH("READ FILE") | |
183 | Q | |
184 | TEST(I) ; | |
185 | Q:I>0 W !,"DID WE QUIT THIS LINE?" | |
186 | W !,"BUT WE DIDN'T QUIT THE S UB ROUTINE " | |
187 | Q | |
188 | T2 ; | |
189 | N MOST,I, J,B | |
190 | S (MOST,I )=0 | |
191 | F S I=$O (^PRCA(430 ,"C",I)) Q :I'>0 D | |
192 | . W !,"I :",I | |
193 | . S (J,B )=0 | |
194 | . F S J =$O(^PRCA( 430,"C",I, J)) Q:J'>0 D | |
195 | .. W ! ,?2,J | |
196 | .. S B =B+1 | |
197 | .. I B >MOST S MO ST=B,BIGE= I W !,?10, "MOST: ",M OST | |
198 | Q | |
199 | AMTPD(BILL IEN) ; | |
200 | ;NOT SURE THIS IS C ORRECT | |
201 | ;BILL IEN FROM PRCA (430 | |
202 | ;TOTALS N ODE 7 PIEC ES 7-10 | |
203 | N ND7,I,T OT | |
204 | S TOT=0 | |
205 | S ND7=$G( ^PRCA(430, BILLIEN,7) ) Q:ND7="" -1 | |
206 | F I=7:1:1 0 D | |
207 | . S TOT= TOT+$P(ND7 ,U,I) | |
208 | Q TOT | |
209 | AMTOWED(BI LLIEN) ; | |
210 | N ND7,I,T OT | |
211 | S TOT=0 | |
212 | S ND7=$G( ^PRCA(430, BILLIEN,7) ) Q:ND7="" -1 | |
213 | F I=1:1:5 D | |
214 | . S TOT= TOT+$P(ND7 ,U,I) | |
215 | Q TOT | |
216 | GETBILLS(R AWD,DIEN) ; | |
217 | ;GET BILL LIST FOR DEBTOR IEN (DIEN) | |
218 | N I,SIEN, TOP4,TOP6, ACTFTOP,TO TTOP,TOPHL DDT,STATTO T,BILLTYPE | |
219 | S SIEN=0 | |
220 | S RAWD=$N A(^TMP($J, "CHMCR2 AC T PROFILE" )) | |
221 | K @RAWD | |
222 | S (ACTFTO P,TOTTOP,T OPHLDDT)=" " | |
223 | I $D(^ RCD(340,"T OP",+DIEN) ) D | |
224 | . S T OP4=$G(^RC D(340,+DIE N,4)) | |
225 | . S T OP6=$G(^RC D(340,+DIE N,6)) | |
226 | . S A CTFTOP=$$B ULLETDT^CH MCRUT2($P( TOP6,U)) ; ACCOUNT FO RWARDED TO TOP (DATE ) | |
227 | . S T OTTOP=$P(T OP4,U,3) ;T OTAL TOP A MOUNT | |
228 | . S T OPHLDDT=$$ BULLETDT^C HMCRUT2($P (TOP6,"^", 6)) | |
229 | ; A CT FOW2TOP TOTAL TOP TOP H OLD DT S TATEMENT D AY | |
230 | S @RAWD@( DIEN)=$G(A CTFTOP)_U_ $G(TOTTOP) _U_$G(TOPH LDDT)_U_$P ($G(^RCD(3 40,DIEN,0) ),U,3) | |
231 | ;S @RA WD@(DIEN," ADDRESS")= $G(^RCD(34 0,DIEN,5)) | |
232 | D GETN MADD(.RAWD ,$P($G(^RC D(340,DIEN ,0)),U,1)) | |
233 | F S S IEN=$O(^PR CA(430,"AS ",DIEN,SIE N)) Q:SIEN '>0 D | |
234 | . S @RAW D@(DIEN,SI EN)=$P($G( ^PRCA(430. 3,SIEN,0)) ,U,1) | |
235 | . S I=0 | |
236 | . S STAT TOT=0 | |
237 | . F S I =$O(^PRCA( 430,"AS",D IEN,SIEN,I )) Q:I'>0 D | |
238 | .. ;I IS NOW BIL L IEN | |
239 | .. ;RA WD(DIEN,ST ATIEN,BILL IEN)=BILL NUM^BILL T YPE^ESTDT^ PRINC^INT^ ADMIN^AMTO WED^AMTPD | |
240 | .. S X =$G(^PRCA( 430,I,0)) | |
241 | .. ;BE LOW LINE A COPY | |
242 | .. S B ILLTYPE=$S ($P(X,"^", 2)=31:"TRI C PT",1:$E ($P($G(^PR CA(430.2,$ S($O(^PRCA (430.2,"AC ",24,0))=$ P(X,"^",2) :+$P(X,"^" ,16),1:+$P (X,"^",2)) ,0)),"^"), 1,7)) | |
243 | .. S @ RAWD@(DIEN ,SIEN,I)=$ P($G(^PRCA (430,I,0)) ,U,1)_U_BI LLTYPE_U_$ $BULLETDT^ CHMCRUT2($ P($G(^PRCA (430,I,0)) ,U,10)) | |
244 | .. S @ RAWD@(DIEN ,SIEN,I)=$ G(@RAWD@(D IEN,SIEN,I ))_U_$P($G (^PRCA(430 ,I,7)),U,1 ,3)_U | |
245 | .. S @ RAWD@(DIEN ,SIEN,I)=$ G(@RAWD@(D IEN,SIEN,I ))_$$AMTOW ED(I)_U_$$ AMTPD(I) | |
246 | .. S $ P(@RAWD@(D IEN,SIEN), U,2)=+$P(@ RAWD@(DIEN ,SIEN),U,2 )+$$AMTOWE D(I) | |
247 | Q | |
248 | GETNMADD(R AWD,ENTPTR ) ; | |
249 | ;RAWDATA REF; ENTIT Y POINTER EG 79729;P RC(440, | |
250 | N IEN,FIL E,REF,NM,A D,ST | |
251 | S IEN=$P( ENTPTR,";" ,1) | |
252 | S FILE=$P (ENTPTR,"; ",2) | |
253 | I FILE="P RC(440," D | |
254 | . S REF= "^"_FILE_I EN_",0)" | |
255 | . S NM=$ P($G(@REF) ,U,1) | |
256 | . S @RAW D@("NAME") =NM | |
257 | . S AD=$ P($G(@REF) ,U,2,8) | |
258 | . S ST=$ P(AD,U,6) | |
259 | . S $P(A D,U,6)=$P( $G(^DIC(5, ST,0)),U,2 ) | |
260 | . S @RAW D@("ADDRES S")=AD | |
261 | I FILE="D PT(" D | |
262 | . S REF= "^"_FILE_I EN_",0)" | |
263 | . S NM=$ P($G(@REF) ,U,1) | |
264 | . S REF= "^"_FILE_I EN_",.11)" | |
265 | . S AD=$ P($G(@REF) ,U,1,6) | |
266 | . S ST=$ P(AD,U,5) | |
267 | . S $P(A D,U,5)=$P( $G(^DIC(5, ST,0)),U,2 ) | |
268 | . S @RAW D@("ADDRES S")=AD | |
269 | Q | |
270 | MASSAGE ; get data i n format f or process ing in the XML proce ssing rout ines | |
271 | ;SAFE KEE PING | |
272 | N CNO,REA SDX,RSCODE ,XMLDT,FMD T,X,RSCODE S | |
273 | S (CNO)=0 | |
274 | F S CNO= $O(@CHRAWD @("CLAIMS" ,CNO)) Q:C NO="" D | |
275 | . S CLAI MNO=CNO | |
276 | . S DUP= 1 | |
277 | . I CNO[ "-" D | |
278 | .. S DU P=$P(CNO," -",2) | |
279 | .. S CL AIMNO=$P(C NO,"-",1) | |
280 | . S @CHR AWD@("CLMS VISITS",CL AIMNO,"DUP ")=DUP | |
281 | . S @CHR AWD@("CLMS VISITS",CL AIMNO)=$G( @CHRAWD@(" CLAIMS",CN O)) | |
282 | . S FMDT =$P(@CHRAW D@("CLMSVI SITS",CLAI MNO),U) | |
283 | . S XMLD T=$$BULLET DT^CHMCRUT 2(FMDT,-1) | |
284 | . S $P(@ CHRAWD@("C LMSVISITS" ,CLAIMNO), U)=XMLDT | |
285 | . S RSCO DES=$P(@CH RAWD@("CLM SVISITS",C LAIMNO),U, 10) | |
286 | . F X=1: 1 S RSCODE =$P(RSCODE S,"*",X) Q :RSCODE="" D | |
287 | .. S RE ASDX=$$GET 1^DIQ(7410 02.22,RSCO DE_",",.02 ) | |
288 | .. S (@ CHRAWD@("C LMSVISITS" ,CLAIMNO," RSN",X))=R SCODE_U_RE ASDX | |
289 | Q | |
290 | ; | |
291 | CHMBLACA ; TESTING C HMBLACA EX TRACT REPL ACEMENT CO DE BELOW | |
292 | Q | |
293 | ; | |
294 | IRSLTRFQ ; | |
295 | ; | |
296 | N LSTWD | |
297 | S LSTWD=^ CHMZHOLD(" REISU-1095 -B") | |
298 | S DAY=$$S ETDAY^CHMB LACA() | |
299 | ;TESTING A FORWARD DATE - CEP | |
300 | S DAY=317 1220 | |
301 | ;COMMENTI NG FOR TES TING | |
302 | ;S ^CHMZH OLD("REISU -1095-B")= DAY | |
303 | S DIR="HA C_HFS$:[SC R.TEMP_FIL ES]" | |
304 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
305 | I UCI'="H AC" S DIR= "HAC_HFS$: [DSMMANAG. CHAMPVA]" | |
306 | ; | |
307 | K ^ZTMPYR ($J) | |
308 | S LSTWD=L STWD-1 F S LSTWD=$O (^CHMZHOLD ("REISU-10 95-B",LSTW D)) Q:(LST WD=DAY)!(' +LSTWD) D | |
309 | . S IYR=0 F S IYR= $O(^CHMZHO LD("REISU- 1095-B",LS TWD,IYR)) Q:'+IYR D | |
310 | . . S ^ZT MPYR($J,IY R)=0 | |
311 | . . S INM ="" F S I NM=$O(^CHM ZHOLD("REI SU-1095-B" ,LSTWD,IYR ,INM)) Q:I NM="" D | |
312 | . . . S ^ ZTMPYR($J, IYR,LSTWD, INM)=^CHMZ HOLD("REIS U-1095-B", LSTWD,IYR, INM) | |
313 | . . . Q | |
314 | . . Q | |
315 | . Q | |
316 | ; | |
317 | S IYR=0 F S IYR=$O (^ZTMPYR($ J,IYR)) Q: '+IYR D | |
318 | . S DT=$Z DATE($H,1) ,DTYR=$P(D T,"/",3),D TYR1=DTYR_ $P(DT,"/") _$P(DT,"/" ,2) | |
319 | . D NOW^% DTC S TM=$ P(%,".",2) | |
320 | . S FNAME ="MEC_Data Extract_O_ "_IYR_"_B_ "_DTYR1_TM _".TXT" | |
321 | . S CHFIO =DIR_FNAME | |
322 | . I '$$OP ENFIWR^CHT FLIB9(.CHF IO,"CHFIO" ) Q | |
323 | . I UCI'= "HAC" U CH FIO W UCI, !! | |
324 | . ; | |
325 | . S LSTWD ="" F S L STWD=$O(^Z TMPYR($J,I YR,LSTWD)) Q:LSTWD=" " D | |
326 | . . S INM ="" F S I NM=$O(^ZTM PYR($J,IYR ,LSTWD,INM )) Q:INM=" " D | |
327 | . . . U C HFIO W ^ZT MPYR($J,IY R,LSTWD,IN M),! | |
328 | . . . Q | |
329 | . ; | |
330 | . D CLOSE F^CHTFLIB9 (CHFIO,"CH FIO") | |
331 | . H 5 | |
332 | . ;D FTPF ILE^CHTFLI B9(CHFIO," DNS fs3. DNS ","/FS3BIG /IRS_LETTE RS","PUT") | |
333 | . H 5 | |
334 | . Q | |
335 | ;D KILLRG BL(DAY) | |
336 | K ^ZTMPYR ($J) | |
337 | Q | |
338 | ; | |
339 | KILLRGBL(D AY) ; | |
340 | ; | |
341 | K ^CHMZHO LD("REISU- 1095-B",DA Y) | |
342 | K ^ZTMPYR ($J) | |
343 | Q | |
344 | TXTRPCLS(R ET) ; | |
345 | ;TXT RPC LIST - FOR RPC LIST TESTER | |
346 | N OUT,OUT 2,COUNT,I, J,K,DESC,R NAM,RIEN,E NTRYPT,FLD NO,PARAMNM ,PARAMSEQ, PARAMREQ,P ARAMDSC,RP DESC,APPEN D | |
347 | S RPCSRCH =$$GETSRCH () | |
348 | Q:$G(RPCS RCH)="" | |
349 | S CTXT2RE Q=$$GETCTX T() | |
350 | Q:$G(CTXT 2REQ)="" | |
351 | S FORMXML =$$GETXMLR Q() | |
352 | S APPEND= $$GETAPND( ) | |
353 | S RET(0)= 0 | |
354 | D FIND^DI C(8994,"", "","",RPCS RCH,"","B" ,"","","OU T") | |
355 | S COUNT = $P($G(OUT ("DILIST", 0)),U) | |
356 | F I=1:1:C OUNT D | |
357 | . S RNAM = $G(OUT( "DILIST",1 ,I)) | |
358 | . S RIEN = $G(OUT( "DILIST",2 ,I)) | |
359 | . S RET( 0)=RET(0)+ 1, RET(RET (0))=RNAM_ "["_CTXT2R EQ_"]{"_RN AM_APPEND_ "}|"_FORMX ML_"|" | |
360 | D PRTLST( .RET) | |
361 | Q | |
362 | XMLRPCLS(R ET,RPCSRCH ,CTXT2REQ, FORMXML) ; | |
363 | ;XML RPC LIST - FOR RPC LIST TESTER | |
364 | ;RPCSRCH: RPC NAME SEARCH VA LUE | |
365 | ;CTXT2REQ : CONTEXT TO REQUIRE FOR ALL R PCS IN RES ULT | |
366 | ;FORMXML: FORMAT A S XML FLAG FOR ALL R PCS IN SET | |
367 | N OUT,OUT 2,COUNT,I, J,K,DESC,R NAM,RIEN,E NTRYPT,FLD NO,PARAMNM ,PARAMSEQ, PARAMREQ,P ARAMDSC,RP DESC | |
368 | Q:$G(RPCS RCH)="" | |
369 | Q:$G(CTXT 2REQ)="" | |
370 | S:(($G(FO RMXML)="") !($G(FORMX ML)'="true ")) FORMXM L="false" | |
371 | S RET(0)= 0 | |
372 | S RET(0)= RET(0)+1, RET(RET(0) )="<?xml v ersion=""1 .0"" encod ing=""UTF- 8""?>" | |
373 | S RET(0)= RET(0)+1, RET(RET(0) )="<rpcLis t xmlns:xs i=""http:/ /www.w3.or g/2001/XML Schema-ins tance"">" | |
374 | D FIND^DI C(8994,"", "","",RPCS RCH,"","B" ,"","","OU T") | |
375 | S COUNT = $P($G(OUT ("DILIST", 0)),U) | |
376 | F I=1:1:C OUNT D | |
377 | . K OUT2 | |
378 | . S RNAM = $G(OUT( "DILIST",1 ,I)) | |
379 | . S RIEN = $G(OUT( "DILIST",2 ,I)) | |
380 | . D GETS ^DIQ(8994, RIEN,".01; .02;.03;.0 4;1;2*;3;" ,"X","OUT2 ") | |
381 | . S ENTR YPT=$G(OUT 2(8994,RIE N_",",.02) )_U_$G(OUT 2(8994,RIE N_",",.03) ) | |
382 | . S J=0 | |
383 | . S DESC ="" | |
384 | . F S J =$O(OUT2(8 994,RIEN_" ,",1,J)) Q :J'>0 D | |
385 | .. S DL N=$G(OUT2( 8994,RIEN_ ",",1,J)) | |
386 | .. S DL N=$$XMLSAF E^CHMCRUTX (DLN) | |
387 | .. S DE SC=DESC_DL N_" " ;;XML'ABL E LINE FEE D | |
388 | . S J=0 | |
389 | . S RPDE SC="" | |
390 | . F S J =$O(OUT2(8 994,RIEN_" ,",3,J)) Q :J'>0 D | |
391 | .. S RL N=$G(OUT2( 8994,RIEN_ ",",3,J)) | |
392 | .. S RL N=$$XMLSAF E^CHMCRUTX (RLN) | |
393 | .. S RP DESC=RPDES C_RLN_" 3;" ;;XML 'ABLE LINE FEED | |
394 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<rpc >" | |
395 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<nam e>"_RNAM_" </name>" | |
396 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<cal lableName> "_RNAM_"</ callableNa me>" | |
397 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<con text>"_CTX T2REQ_"</c ontext>" | |
398 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<for matAsXML>" _FORMXML_" </formatAs XML>" | |
399 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<ent ryPoint>"_ ENTRYPT_"< /entryPoin t>" | |
400 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<des cription>" _DESC_"</d escription >" | |
401 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<ret urnParamet erDescript ion>"_RPDE SC_"</retu rnParamete rDescripti on>" | |
402 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="<par ams>" | |
403 | . ;;NOW GET THE PA RAMS... | |
404 | . S FLDN O="" | |
405 | . F S F LDNO=$O(OU T2(8994.02 ,FLDNO)) Q :FLDNO="" D | |
406 | .. S PA RAMSEQ=$G( OUT2(8994. 02,FLDNO,. 05)) | |
407 | .. S PA RAMNM=$G(O UT2(8994.0 2,FLDNO,.0 1)) | |
408 | .. S PA RAMREQ="fa lse" S:$G( OUT2(8994. 02,FLDNO,. 04))="YES" PARAMREQ= "true" | |
409 | .. S K= 0 | |
410 | .. S PA RAMDSC="" | |
411 | .. F S K=$O(OUT2 (8994.02,F LDNO,1,K)) Q:K'>0 D | |
412 | ... S PLN=$G(OUT 2(8994.02, FLDNO,1,K) ) | |
413 | ... S PLN=$$XMLS AFE^CHMCRU TX(PLN) | |
414 | ... S PARAMDSC=P ARAMDSC_PL N_" " ;;XML'ABL E LINE FEE D | |
415 | .. ;;XM LIZE THE P ARAM | |
416 | .. S RE T(0)=RET(0 )+1, RET(R ET(0))="<p aram>" | |
417 | .. S RE T(0)=RET(0 )+1, RET(R ET(0))="<p arameterNa me>"_PARAM NM_"</para meterName> " | |
418 | .. S RE T(0)=RET(0 )+1, RET(R ET(0))="<p arameterDe scription> "_PARAMDSC _"</parame terDescrip tion>" | |
419 | .. S RE T(0)=RET(0 )+1, RET(R ET(0))="<p arameterRe quired>"_P ARAMREQ_"< /parameter Required>" | |
420 | .. S RE T(0)=RET(0 )+1, RET(R ET(0))="<p arameterSe quence>"_P ARAMSEQ_"< /parameter Sequence>" | |
421 | .. S RE T(0)=RET(0 )+1, RET(R ET(0))="</ param>" | |
422 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="</pa rams>" | |
423 | . S RET( 0)=RET(0)+ 1, RET(RET (0))="</rp c>" | |
424 | S RET(0)= RET(0)+1, RET(RET(0) )="</rpcLi st>" | |
425 | Q | |
426 | MOSTROCS ; FIND BENE/ SPONS WITH MOST ROCS | |
427 | N DFN,BFN ,COUNT,HIG H | |
428 | S (HIGH,C OUNT)=0 | |
429 | S DFN=999 9999 | |
430 | F S DFN= $O(^AHCHVA (DFN),-1) Q:DFN'>0 D | |
431 | . S BFN =0 | |
432 | . F S BFN=$O(^AH CHVA(DFN,1 00,BFN)) Q :BFN'>0 D | |
433 | .. S C OUNT=0 | |
434 | .. D G ETRAWRO(.C OUNT,DFN,B FN) | |
435 | .. I C OUNT>HIGH D | |
436 | ... S HIGH=COUN T | |
437 | ... W !,"CURREN T HIGH: ", HIGH," DF N-BFN: ",D FN,"-",BFN | |
438 | Q | |
439 | GETRAWRO(C OUNT,CHDFN ,CHBFN) ; Get raw da ta custome r ROC | |
440 | ; standar dize the s ponsor and bene name s | |
441 | ; | |
442 | N ROCIEN, ZNODE,NODE 1,GLOB | |
443 | ; | |
444 | ; | |
445 | ;WARNING DO NOT KIL L @GLOB as this will kill the global dat a | |
446 | ;FIRST - GET BENE R EGULAR ROC S | |
447 | S GLOB="^ AHCHVA("_C HDFN_",100 ,"_CHBFN_" ,106)" | |
448 | D GETROCS (.ROCOUNT, GLOB,"BENE ",554801.1 106) | |
449 | S COUNT=C OUNT+ROCOU NT | |
450 | ;SECOND - GET BENE SPINA ROCS | |
451 | S GLOB="^ AHCHVA("_C HDFN_",100 ,"_CHBFN_" ,116)" | |
452 | D GETROCS (.ROCOUNT, GLOB,"BENE SB",554801 .1116) | |
453 | S COUNT=C OUNT+ROCOU NT | |
454 | ;THIRD - GET SPONSO R SPINA RO CS | |
455 | S GLOB="^ AHCHVA("_C HDFN_",106 )" | |
456 | D GETROCS (.ROCOUNT, GLOB,"SPON ",554801.0 106) | |
457 | S COUNT=C OUNT+ROCOU NT | |
458 | ;LAST - G ET SPONSOR SPINA ROC S | |
459 | S GLOB="^ AHCHVA("_C HDFN_",116 )" | |
460 | D GETROCS (.ROCOUNT, GLOB,"SPON SB",554801 .0116) | |
461 | S COUNT=C OUNT+ROCOU NT | |
462 | ; | |
463 | GETROCS(CN T,GLOB,RET BASE,ROCFL D) ; | |
464 | ;GET T HE ROCS | |
465 | ;INPUT : CHRET (R EF) | |
466 | ; GLOB - T HE ROOT FO R THE ROC EG AHCHVA( DFN,100,BF N,106 | |
467 | ; R ETBASE - T HE NODE IN CHRET TO PUT THE DA TA | |
468 | ; R OCFLD - THE FIELD NUM OF THE MULTIPLE OF THE ROC OR SBROC FOR THAT L EVEL - EG 554801.010 6, .0116, .1106, .11 16 | |
469 | N MYAU DIT | |
470 | S CNT= 0 | |
471 | S ROCIEN= 9999999 | |
472 | Q:$G(ROCF LD)'>0 | |
473 | F S ROCI EN=$O(@GLO B@(ROCIEN) ,-1) Q:ROC IEN'>0 D | |
474 | . S CNT= CNT+1 | |
475 | Q | |
476 | GETSRCH() ;prompt us er RPC NAM E SEARCH | |
477 | ; | |
478 | N DIR,X,Y ,DIRUT | |
479 | S DIR("B" )="" | |
480 | S DIR(0)= "FO" | |
481 | S DIR("A" )="Enter f irst-chara cters sear ch to matc h RPCs" | |
482 | D ^DIR | |
483 | Q X | |
484 | ; | |
485 | GETCTXT() ;PROMPT US ER FOR CON TEXT | |
486 | ; | |
487 | S DIC("A" )="Enter C ontext Nam e: " | |
488 | S DIC="^D IC(19," | |
489 | S DIC("S" )="I $P(^( 0),U,4)="" B""" ;SC REEN - ONL Y LIST BRO KER-TYPE O PTIONS | |
490 | S DIC(0)= "AEQMZ" | |
491 | D ^DIC | |
492 | ; | |
493 | Q $P($G(Y ),U,2) | |
494 | GETXMLRQ() ;GET XML REQUIRED T RUE/FALSE | |
495 | N DIR,X,Y,DI RUT | |
496 | S DIR("B")=" F" | |
497 | S DIR(0)="SX ^T:true;F: false" | |
498 | S DIR("A")=" Enter whet her ALL RP Cs in resu lt will be marked as response is xml-for matted = [ true] or [ false]" | |
499 | D ^DIR | |
500 | Q Y(0) | |
501 | GETAPND() ;GET TEXT TO APPEND TO DISPLAY NAME | |
502 | ; | |
503 | ;N DIR,X, Y,DIRUT | |
504 | S DIR("B" )="" | |
505 | S DIR(0)= "FO" | |
506 | S DIR("A" )="Enter t ext to app end to dis play name (eg. ""-TF "") or ent er for non e" | |
507 | D ^DIR | |
508 | Q X | |
509 | ; | |
510 | PRTLST(RES P) | |
511 | N I | |
512 | S I=0 | |
513 | F S I=$O (RESP(I)) Q:I'>0 W !,RESP(I) | |
514 | Q | |
515 | ; |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.