Produced by Araxis Merge on 11/9/2018 12:33:57 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 | CHMKAIS2.m | Mon Nov 5 16:40:06 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMKAIS2.m | Mon Nov 5 17:48:38 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 672 |
Changed | 1 | 4 |
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 | CHMKAIS2 ; HAC/AHJ;$$ CHAMPVA S AVINGS FRO M AI OUTPU T TO SPREA DSHEET | |
2 | ;;1.0;CHA MPVA SYSTE M;;JULY 4, 1990;Buil d 1 | |
3 | ; | |
4 | ;MTN01347 1 JSE - 10 /28/11 FIX UNDEF ERR OR FMJUL+5 | |
5 | ; | |
6 | ZSET S:'$D (DUZ) DUZ= 1,DUZ(0)=" " I '$D(DT ) S %DT="" ,X="T" D ^ %DT S DT=Y | |
7 | S:'$D(IOZ FO) IOZFO= "^^" S:'$D (IOZBK) IO ZBK="^" S: '$D(DTIME) DTIME=60 | |
8 | I '$D(IOZ ) S %ZIS=" N" S IOP=" HOME" D HO ME^%ZIS S IOZ=IO,IOZ L=IOSL,IOZ W=IOM,IOZF =IOF,IOZT= IOST,IOZN= ION,IOZS=I OS | |
9 | S Y=0 | |
10 | ; | |
11 | A4 ;Start Printer he re | |
12 | D START^C HMKAIS2,EN D^CHMKAIS2 | |
13 | Q | |
14 | START ; Y2 K Modified start log ic to hand le new PDI format | |
15 | I CHPGTYP ="1" S HDT ITLE="CHAM PVA AI Sav ings" | |
16 | ;I CHPGTY P="CHF" S HDTITLE="C HAMPVA For eign AI Sa vings" | |
17 | ;I CHPGTY P="FMP" S HDTITLE="F oreign Med ical Progr am AI Savi ngs" | |
18 | ;I CHPGTY P="PGW" S HDTITLE="P ersian Gul f Program AI Savings " | |
19 | I CHPGTYP ="6" S HDT ITLE="Spin a Bifida A I Savings" | |
20 | I CHPGTYP ="7" S HDT ITLE="Chil dren of Wo men Vietna m Vets AI Savings" | |
21 | I CHPGTYP ="A" S HDT ITLE="ALL AI Savings " | |
22 | S X=CHDT D DTPRT S CHDTP1=Y S X=CHDT2 D DTPRT S C HDTP2=Y | |
23 | S HSTRDAT =$E(CHDT,4 ,5)_$E(CHD T,6,7)_$E( CHDT,2,3) | |
24 | S HENDDAT =$E(CHDT2, 4,5)_$E(CH DT2,6,7)_$ E(CHDT2,2, 3) | |
25 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1) | |
26 | ;S FIO="H ACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .AI-SAVING S-REPORT]A I-SAVINGS- REPORT-"_H STRDAT_"-" _ HENDDAT_ ".XLS" | |
27 | I CHUCI=" HAC" S FIO ="HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .AI-SAVING S-REPORT]A I-SAVINGS- REPORT-"_H DTITLE_"-" _HSTRDAT_" -"_ HENDDA T_".XLS" | |
28 | I CHUCI'= "HAC" S FI O="HAC_HFS $:[DSMMANA G.CHAMPVA] "_CHUCI_"_ "_HDTITLE_ "-"_HSTRDA T_"-"_ HEN DDAT_".DAT " | |
29 | O FIO C F IO:"D" | |
30 | O FIO:"NW V" | |
31 | S T=$C(9) | |
32 | S CNT=0 | |
33 | S STOPMO= 0 | |
34 | S PCITISW =0 | |
35 | S T=$C(9) | |
36 | S SW=0 | |
37 | S TOT1=0, TOT2=0,TOT 3=0 | |
38 | S CNT=0 | |
39 | D NOW^%DT C S RUNTIM E=% | |
40 | S TODAY=$ E(RUNTIME, 1,7) | |
41 | S CHTOT=0 ,CHBILL=0, CHCLAIM=0, CT=0,PAID= 0 | |
42 | S X1=$$FM JUL(CHDT) | |
43 | S X2=$$FM JUL(CHDT2) | |
44 | ;NEXT 2 L INES NEW S TART AND E ND DATES | |
45 | ;S X1=$$F MJUL(STRDT ) | |
46 | ;S X2=$$F MJUL(ENDDT ) | |
47 | ; 13 Digi t PDI Loop | |
48 | I CHDT<30 00000 D | |
49 | .S PDI=X1 _"00000000 " | |
50 | .S PDI2=X 2_"9999999 9" | |
51 | .S:CHDT2> 3000000 PD I2=9999999 999999 | |
52 | .D START2 | |
53 | .Q | |
54 | ; 15 digi t PDI Loop | |
55 | S PDI=$$C EN2^CHMFPD I2(X1)_X1_ "00000000" | |
56 | ;S PDI=20 0700503017 996 | |
57 | S PDI2=$$ CEN2^CHMFP DI2(X2)_X2 _"99999999 " | |
58 | D START2 | |
59 | ; | |
60 | D HEAD | |
61 | D PRINT | |
62 | K ^CHMZHO LD($J,"AIA I") | |
63 | Q | |
64 | ; | |
65 | START2 F S PDI=$O(^ CHMPAY("C" ,PDI)) Q:( PDI>PDI2)! 'PDI S CI =0 F S CI =$O(^CHMPA Y("C",PDI, CI)) Q:'CI D | |
66 | .Q:'$D(^C HMPAY(CI,0 )) S REC0 =^(0) | |
67 | .Q:$P(REC 0,"^",2)=1 Q:$P(REC 0,"^",2)=7 ;QUIT IF STATUS IN PROGRESS,A DMIN SUSPE NSE | |
68 | .Q:$P(REC 0,"^",2)=1 0 ;QUIT IF STATUS DE LETED | |
69 | .Q:$P(REC 0,"^",7)'= 2 ;QUIT IF TYPE NOT OUTPATIENT | |
70 | .;NEED EX TERNAL CLA IM NUMBER HERE CI=IN TERNAL NUM BER CII=E XTERNAL NU MBER | |
71 | .S CII=$P (REC0,"^", 1) ;AHJ | |
72 | .; NEX T LINE FIN D EACH CLA IM PROGRAM TYPE AHJ | |
73 | .;Q:'$D(^ CHMINDEX(" B",CII)) S CLMPT=0, CLMPT=$O(^ CHMINDEX(" B",CII,CLM PT)) S IND X0=^CHMIND EX(CLMPT,0 ) S PROGTY PE=$P(INDX 0,"^",2) Q :PROGTYPE= "" ;AHJ | |
74 | .S X1=CI D PROGTYP^ CHFCD001 S PROGTYPE= CHPGPT | |
75 | .;NEXT LI NE MATCH C LAIM PROGR AM TYPE TO REQUESTED PROGRAM | |
76 | .;I CHPGT YP'="A" I CHPGTYP'=" CIT" Q:PRO GTYPE'=CHP GTYP ; AHJ SELECT PR OGRAM TYPE HERE | |
77 | .I CHPGTY P=1 I PROG TYPE'=1 I PROGTYPE'= 2 Q ;QUIT IF NOT CV A OR CVAF | |
78 | .I CHPGTY P=6 Q:PROG TYPE'=CHPG TYP | |
79 | .I CHPGTY P=7 Q:PROG TYPE'=CHPG TYP | |
80 | .; | |
81 | .;NEXT LI NE FIND CI TI CLAIMS | |
82 | .I CHPGTY P="CIT" I $E(PDI,8,9 )="04" Q | |
83 | .; | |
84 | .;NEXT 2 LINES PDI JULIAN CON VERT TO DA TE MONTH | |
85 | .S CHPDID T=$$PDIJUL FM^CHMFPDI 2(PDI) | |
86 | .S MO=$E( CHPDIDT,4, 5) | |
87 | .S:($P(RE C0,"^",7)= 2)!($P(REC 0,"^",7)=6 )!($P(REC0 ,"^",7)=5) RULE="RUL E-PROC" ;T YPE =OUTPA TIENT, DEN TAL OR TRA VEL | |
88 | .S:$P(REC 0,"^",7)=3 RULE="RUL E=PHARM" ; TYPE=PHARM ACY | |
89 | .Q:'$D(^C HMPAY(CI,R ULE)) ;ONL Y RULE="RU LE-PROC" | |
90 | .S J=0,PT OT=0,PBILL =0 F S J= $O(^CHMPAY (CI,RULE,J )) Q:'J D | |
91 | ..Q:$P(^C HMPAY(CI,R ULE,J,0)," ^",1)'=0 ; COVERAGE C ODE = REJE CT | |
92 | ..S REAS= $P(^CHMPAY (CI,RULE,J ,0),"^",2) Q:REAS>99 9 Q:REAS= "" ;GET AI REASON ( CHMDIC(741 002.22 | |
93 | ..I '$D(^ CHMZHOLD($ J,"AIAI"," TMP-MATCH" ,REAS)) Q ; OUT FOR TEST ONLY | |
94 | ..S STFL= 0 | |
95 | ..I $D(^C HMPAY(CI," RULE-QA")) S QJ=0 F S QJ=$O(^ CHMPAY(CI, "RULE-QA", QJ)) Q:'QJ D ; | |
96 | ...Q:$P(^ (QJ,0),"^" ,3)'=J | |
97 | ...S:$P(^ (0),"^",5) '="" STFL= 1 | |
98 | ..Q:STFL | |
99 | ..I ($P(R EC0,"^",7) =2)!($P(RE C0,"^",7)= 6) D ^CHKC CSA2 D ; MUST BE OU TPATIENT O R DENTAL | |
100 | ...S:CHMP F>$P(^CHMP AY(CI,"OPT -PROC",J,0 ),"^",2) C HMPF=$P(^C HMPAY(CI," OPT-PROC", J,0),"^",2 ) | |
101 | ...S:CHMP F=0 CHMPF= $P(^CHMPAY (CI,"OPT-P ROC",J,0), "^",2) | |
102 | ..S CHCLA IM=CHCLAIM +1 | |
103 | ..S:($P(R EC0,"^",7) =2)!($P(RE C0,"^",7)= 6) PBILL=P BILL+$P(^C HMPAY(CI," OPT-PROC", J,0),"^",2 ),PTOT=PTO T+CHMPF,BI LL=$P(^CHM PAY(CI,"OP T-PROC",J, 0),"^",2) | |
104 | ..S:$P(RE C0,"^",7)= 3 PBILL=PB ILL+$P(^CH MPAY(CI,"P HARM",J,0) ,"^",4),PT OT=PTOT+$P (^CHMPAY(C I,"PHARM", J,0),"^",4 ),(CHMPF,B ILL)=$P(^C HMPAY(CI," PHARM",J,0 ),"^",4) | |
105 | ..S:$P(RE C0,"^",7)= 4 PBILL=PB ILL+$P(^CH MPAY(CI,"D ME-SUPPLY" ,J,0),"^", 2),PTOT=PT OT+$P(^CHM PAY(CI,"DM E-SUPPLY", J,0),"^",2 ),(CHMPF,B ILL)=$P(^C HMPAY(CI," DME-SUPPLY ",J,0),"^" ,2) | |
106 | ..S:$P(RE C0,"^",7)= 5 PBILL=PB ILL+$P(^CH MPAY(CI,"D EN-PROC",J ,0),"^",2) ,PTOT=PTOT +$P(^CHMPA Y(CI,"DEN- PROC",J,0) ,"^",2),(C HMPF,BILL) =$P(^CHMPA Y(CI,"DEN- PROC",J,0) ,"^",2) | |
107 | ..S:'$D(^ CHMZHOLD($ J,"AIAI"," TEST",REAS ,1)) ^CHMZ HOLD($J,"A IAI","TEST ",REAS,1)= "0^0^0^0^0 ^0^0^0^0^0 ^0^0^" ;AH J | |
108 | ..S:'$D(^ CHMZHOLD($ J,"AIAI"," TEST",REAS ,2)) ^CHMZ HOLD($J,"A IAI","TEST ",REAS,2)= "0^0^0^0^0 ^0^0^0^0^0 ^0^0^" ;AH J | |
109 | ..S:'$D(^ CHMZHOLD($ J,"AIAI"," TEST",REAS ,3)) ^CHMZ HOLD($J,"A IAI","TEST ",REAS,3)= "0^0^0^0^0 ^0^0^0^0^0 ^0^0^" ;AH J | |
110 | ..S:'$D(^ CHMZHOLD($ J,"AIAI"," AAAA",RUNT IME)) ^CHM ZHOLD($J," AIAI","AAA A",RUNTIME )="0^0^0^0 ^0^0^0^0^0 ^0^0^0^" ; AHJ TOTAL S FOR COUN T PROC | |
111 | ..S:'$D(^ CHMZHOLD($ J,"AIAI"," BBBB",RUNT IME)) ^CHM ZHOLD($J," AIAI","BBB B",RUNTIME )="0^0^0^0 ^0^0^0^0^0 ^0^0^0^" ; AHJ TOTALS FOR BILLE D CHARGES | |
112 | ..S:'$D(^ CHMZHOLD($ J,"AIAI"," ZZZZ",RUNT IME)) ^CHM ZHOLD($J," AIAI","ZZZ Z",RUNTIME )="0^0^0^0 ^0^0^0^0^0 ^0^0^0^" ; AHJ TOTALS FOR ALLOW ABLE SAVIN GS | |
113 | ..S $P(^C HMZHOLD($J ,"AIAI","T EST",REAS, 1),"^",MO) =$P(^CHMZH OLD($J,"AI AI","TEST" ,REAS,1)," ^",MO)+1 ; AHJ Allow Charges | |
114 | ..S $P(^C HMZHOLD($J ,"AIAI","T EST",REAS, 2),"^",MO) =$P(^CHMZH OLD($J,"AI AI","TEST" ,REAS,2)," ^",MO)+BIL L ;AHJ Bil led Charge s | |
115 | ..S $P(^C HMZHOLD($J ,"AIAI","T EST",REAS, 3),"^",MO) =$P(^CHMZH OLD($J,"AI AI","TEST" ,REAS,3)," ^",MO)+CHM PF ;AHJ Co unt proced ures | |
116 | ..S $P(^C HMZHOLD($J ,"AIAI","A AAA",RUNTI ME),"^",MO )=$P(^CHMZ HOLD($J,"A IAI","AAAA ",RUNTIME) ,"^",MO)+1 ;AHJ GRAN D TOTALS C OUNT PROC | |
117 | ..S $P(^C HMZHOLD($J ,"AIAI","B BBB",RUNTI ME),"^",MO )=$P(^CHMZ HOLD($J,"A IAI","BBBB ",RUNTIME) ,"^",MO)+B ILL ;AHJ G RAND TOT B ILLED CHAR GES | |
118 | ..S $P(^C HMZHOLD($J ,"AIAI","Z ZZZ",RUNTI ME),"^",MO )=$P(^CHMZ HOLD($J,"A IAI","ZZZZ ",RUNTIME) ,"^",MO)+C HMPF ;AHJ GRAND TOT ALLOW SAVI NGS | |
119 | .S CHTOT= CHTOT+PTOT ,CHBILL=CH BILL+PBILL | |
120 | .I PTOT'= 0 S CT=CT+ 1 S:$D(^CH MPAY(CI,1) ) PAID=PAI D+$P(^CHMP AY(CI,1)," ^",1) | |
121 | .Q | |
122 | Q | |
123 | ; | |
124 | PRINT ; | |
125 | S T=$C(9) | |
126 | D FIXMO | |
127 | S ATIME=0 ,TOT1=0 | |
128 | G:'$D(^CH MZHOLD($J, "AIAI","AA AA")) STOP IT | |
129 | S ATIME=$ O(^CHMZHOL D($J,"AIAI ","AAAA",A TIME)) | |
130 | S TOT1=^C HMZHOLD($J ,"AIAI","A AAA",ATIME ) | |
131 | ; | |
132 | ;roll tot als for to tal denied proc | |
133 | F X=10:1: 12 S J=X S J=J-9 S R OLL(J)=$P( TOT1,"^",X ) | |
134 | F X=1:1:9 S J=X+3 S ROLL(J)=$ P(TOT1,"^" ,X) | |
135 | F X=2:1:S TOPMO S J= X-1 S ROLL (X)=ROLL(X )+ROLL(J) | |
136 | D FIXMO | |
137 | ;W !,"EOB "_T_"Total Denied Pr oc"_T S J= 25 F X=1:1 :STOPMO U FIO W ?J,$ J(ROLL(X), 8,0)_T S J =J+9 | |
138 | F X=1:1:1 2 S $P(LIN E,T,(X))=$ J(ROLL(X), 8,0) | |
139 | S TOGETHE R="EOB"_T_ "Total Den ied Proc"_ T_LINE | |
140 | U FIO W T OGETHER,! | |
141 | ; | |
142 | ;original code with separate month tota ls | |
143 | ;W !,"EOB " W ?5,"To tal Denied Proc" S J =25 F X=10 :1:12 W ?J ,$J($P(TOT 1,"^",X),8 ,0) S J=J+ 9 | |
144 | ;S J=52 F X=1:1:9 W ?J,$J($P( TOT1,"^",X ),8) S J=J +9 | |
145 | ; | |
146 | S BTIME=0 ,TOT2=0 | |
147 | S BTIME=$ O(^CHMZHOL D($J,"AIAI ","BBBB",B TIME)) | |
148 | S TOT2=^C HMZHOLD($J ,"AIAI","B BBB",BTIME ) | |
149 | ; | |
150 | ;roll tot als for to t Denied B ill Crg | |
151 | F X=10:1: 12 S J=X S J=J-9 S R OLL1(J)=$P (TOT2,"^", X) | |
152 | F X=1:1:9 S J=X+3 S ROLL1(J)= $P(TOT2,"^ ",X) | |
153 | F X=2:1:S TOPMO S J= X-1 S ROLL 1(X)=ROLL1 (X)+ROLL1( J) | |
154 | D FIXMO | |
155 | ;U FIO W !,"Reas"_T U FIO W ? 5,"Tot Den ied Bill C rg"_T S J= 25 F X=1:1 :STOPMO U FIO W ?J,$ J(ROLL1(X) ,8,0)_T S J=J+9 ; | |
156 | F X=1:1:1 2 S $P(LIN E,T,(X))=$ J(ROLL1(X) ,8,0) | |
157 | S TOGETHE R1="Reas"_ T_"Total B ill Crg"_T _LINE | |
158 | U FIO W T OGETHER1,! ! | |
159 | ; | |
160 | ;original code with separate month tota ls | |
161 | ;W !,"Rea s " W ?5," Tot Denied Bill Crg" S J=25 F X=10:1:12 W ?J,$J($P (TOT2,"^", X),8,0) S J=J+9 | |
162 | ;S J=52 F X=1:1:9 W ?J,$J($P( TOT2,"^",X ),8,0) S J =J+9 | |
163 | DETAIL ; | |
164 | S REAS=0 | |
165 | T1 ; | |
166 | S REAS=$O (^CHMZHOLD ($J,"AIAI" ,"TEST",RE AS)) I REA S="" G END TOT | |
167 | S LEV=0 | |
168 | T2 ; | |
169 | S LEV=$O( ^CHMZHOLD( $J,"AIAI", "TEST",REA S,LEV)) I LEV="" G T 1 | |
170 | S DET1=^C HMZHOLD($J ,"AIAI","T EST",REAS, LEV) | |
171 | ; | |
172 | ;roll tot als for pr ocedures d enied | |
173 | I LEV=1 F X=10:1:12 S J=X S J =J-9 S ROL L3(J)=$P(D ET1,"^",X) | |
174 | I LEV=1 F X=1:1:9 S J=X+3 S R OLL3(J)=$P (DET1,"^", X) | |
175 | I LEV=1 F X=2:1:STO PMO S J=X- 1 S ROLL3( X)=ROLL3(X )+ROLL3(J) | |
176 | D FIXMO | |
177 | ;I LEV=1 U FIO W ?5 ,"Procedur es Denied" _T S J=25 F X=1:1:ST OPMO U FIO W ?J,$J(R OLL3(X),8, 0)_T S J=J +9 | |
178 | I LEV=1 F X=1:1:12 S $P(LINE, T,(X))=$J( ROLL3(X),8 ,0) | |
179 | I LEV=1 S TOGETHER3 =T_"Proced ures Denie d"_T_LINE | |
180 | I LEV=1 U FIO W TOG ETHER3,! | |
181 | ; | |
182 | ;Original code with separate month tota ls | |
183 | ;I LEV=1 W !! | |
184 | ;I LEV=1 W ?5,"Proc edures Den ied" S J=2 5 F X=10:1 :12 W ?J,$ J($P(DET1, "^",X),8,0 ) S J=J+9 | |
185 | ;I LEV=1 S J=52 F X =1:1:9 W ? J,$J($P(DE T1,"^",X), 8) S J=J+9 | |
186 | ; | |
187 | ;Roll Tot als for De nied Bill Charges | |
188 | I LEV=2 F X=10:1:12 S J=X S J =J-9 S ROL L4(J)=$P(D ET1,"^",X) | |
189 | I LEV=2 F X=1:1:9 S J=X+3 S R OLL4(J)=$P (DET1,"^", X) | |
190 | I LEV=2 F X=2:1:STO PMO S J=X- 1 S ROLL4( X)=ROLL4(X )+ROLL4(J) | |
191 | ;I LEV=2 U FIO W !! | |
192 | D FIXMO | |
193 | ;I LEV=2 U FIO W !, REAS_T W ? 5,"Denied Bill Charg es"_T S J= 25 F X=1:1 :STOPMO U FIO W ?J,$ J(ROLL4(X) ,8,0)_T S J=J+9 | |
194 | I LEV=2 F X=1:1:12 S $P(LINE, T,(X))=$J( ROLL4(X),8 ,0) | |
195 | I LEV=2 S TOGETHER4 =REAS_T_"D enied Bill Charges"_ T_LINE | |
196 | I LEV=2 U FIO W TOG ETHER4,! | |
197 | ; | |
198 | ;Original code with separate month tota ls | |
199 | ;I LEV=2 W !,REAS W ?5,"Deni ed Bill Ch arges" S J =25 F X=10 :1:12 W ?J ,$J($P(DET 1,"^",X),8 ,0) S J=J+ 9 | |
200 | ;I LEV=2 S J=52 F X=1:1:9 W ?J,$J($P(D ET1,"^",X) ,8,0) S J= J+9 | |
201 | ; | |
202 | ;roll tot als for al lowable sa vings | |
203 | I LEV=3 F X=10:1:12 S J=X S J =J-9 S ROL L5(J)=$P(D ET1,"^",X) | |
204 | I LEV=3 F X=1:1:9 S J=X+3 S R OLL5(J)=$P (DET1,"^", X) | |
205 | I LEV=3 F X=2:1:STO PMO S J=X- 1 S ROLL5( X)=ROLL5(X )+ROLL5(J) | |
206 | ;I LEV=3 U FIO W !! | |
207 | D FIXMO | |
208 | ;I LEV=3 U FIO W !, " "_T W ?5 ,"Allowabl e Savings" _T S J=25 F X=1:1:ST OPMO U FIO W ?J,$J(R OLL5(X),8, 0)_T S J=J +9 | |
209 | I LEV=3 F X=1:1:12 S $P(LINE, T,(X))=$J( ROLL5(X),8 ,0) | |
210 | I LEV=3 S TOGETHER5 =T_"Allowa ble Saving s"_T_LINE | |
211 | I LEV=3 U FIO W TOG ETHER5,!! | |
212 | ; | |
213 | ;original code sepa rate month totals | |
214 | ;I LEV=3 W !," " W ?5,"Allowa ble Saving s:" S J=25 F X=10:1: 12 W ?J,$J ($P(DET1," ^",X),8,0) S J=J+9 | |
215 | ;I LEV=3 S J=52 F X =1:1:9 W ? J,$J($P(DE T1,"^",X), 8,0) S J=J +9 | |
216 | G T2 | |
217 | Q | |
218 | ENDTOT ; | |
219 | S ZTIME=0 ,TOT3=0 | |
220 | S ZTIME=$ O(^CHMZHOL D($J,"AIAI ","ZZZZ",Z TIME)) | |
221 | S TOT3=^C HMZHOLD($J ,"AIAI","Z ZZZ",ZTIME ) | |
222 | U FIO W T _"Total CH AMPVA",! | |
223 | ; | |
224 | ;roll to tals for g rand total allowable savings | |
225 | F X=10:1: 12 S J=X S J=J-9 S R OLL6(J)=$P (TOT3,"^", X) | |
226 | F X=1:1:9 S J=X+3 S ROLL6(J)= $P(TOT3,"^ ",X) | |
227 | F X=2:1:S TOPMO S J= X-1 S ROLL 6(X)=ROLL6 (X)+ROLL6( J) | |
228 | D FIXMO | |
229 | ;U FIO W !,?5,"Allo wable Savi ngs"_T S J =25 F X=1: 1:STOPMO U FIO W ?J, $J(ROLL6(X ),8,0)_T S J=J+9 | |
230 | F X=1:1:1 2 S $P(LIN E,T,(X))=$ J(ROLL6(X) ,8,0) | |
231 | S TOGETHE R6=T_"Allo wable Savi ngs"_T_LIN E | |
232 | U FIO W T OGETHER6 | |
233 | ; | |
234 | ;original code sepa rate month totals | |
235 | ;W !,?5," Allowable Savings:" S J=25 F X =10:1:12 W ?J,$J($P( TOT3,"^",X ),8,0) S J =J+9 | |
236 | ;S J=52 F X=1:1:9 W ?J,$J($P( TOT3,"^",X ),8,0) S J =J+9 | |
237 | ; | |
238 | S REASON= 0 | |
239 | U FIO W ! | |
240 | E1 ; | |
241 | S REASON= $O(^CHMZHO LD($J,"AIA I","TMP-MA TCH",REASO N)) I REAS ON="" G EN D | |
242 | S REASDIS =$P(^CHMDI C(741002.2 2,REASON,0 ),"^",2) | |
243 | S TOGETHE R7="#"_REA SON_T_REAS DIS | |
244 | ;U FIO W !,"#",REAS ON_T,?5,RE ASDIS | |
245 | U FIO W ! ,TOGETHER7 | |
246 | G E1 | |
247 | Q | |
248 | QUEUEIT ; | |
249 | ;W !,"HER E IS THE P RINT STUFF " | |
250 | S ZTDTH=$ H | |
251 | S ZTRTN=" A4^CHMKAIS 1" | |
252 | S ZTDESC= "AI REPORT " | |
253 | S ZTSAVE( "*")="",ZT SAVE("^CHM ZHOLD($J," "AIAI"",") ="" | |
254 | D ^%ZTLOA D | |
255 | W !!?5,"R eport Queu ed!" | |
256 | D HOME^%Z IS Q | |
257 | Q | |
258 | END ; | |
259 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1) | |
260 | I CHUCI=" HAC" S X=$ ZF(-1,"SUB MIT HAC_HF S$:[SCR.TE MP_FILES]R EC_COPY.CO M/PARAM=(" _FIO_")") | |
261 | C FIO | |
262 | K X,X12,Y ,TOT,TOT2, TOT3,TOGET HER7,TOGET HER6,TOGET HER5,TOGET HER4,TOGET HER3 | |
263 | K TOGETHE R2,TOGETHE R1,TOGETHE R,T,T1,T2, ROLL6,ROLL 5,ROLL4,RO LL3,ROLL1, RULE | |
264 | K RUNTIME ,ROLL,MCHD T,MCHDT2,M O,MSYS,NM, PAID,PBILL ,PCITISW,P DI,PDI2,PG ,POP,PROGS W | |
265 | K PROGTYP E,PTOT,QJ, REAS,REASD IS,REASON, QJ,REC0,RM SDF,TOT1,X 1,X2,TS,YR ,TODAY,TIM E,TEST | |
266 | K XTS,SW, STOPMO,STF L,PF,M,LIN E,LEV,K2,J ,CT,DET1,E NDMO,FN,H, HDTITLE,HE NDDAT,HSTR DAT | |
267 | K I,INDX0 ,CHMPF,CHM POS,CHMRDT ,CHMREC,CH MRSD,CHMSP ,CHMSPC,CH PDIDT,CHPG PT,CHPGTYP | |
268 | K SDUZ,CH UCI,CHUCIP T,CHX,CI,C II,CNT,BIL L,BTIME,CH ADOC,CHBIL L,CHCLS,CH CMDT,CHDT, CHDT2 | |
269 | K CHEXT,C HFIO,CHLDT ,CHLNM,CHL OC,CHMDOS, CHMFAC,CHM FQUE,CHMMD P,CHPNM,CH SYS,CHTOT | |
270 | K CHADOS, CHCLAIM,CH DTP1,CHDTP 2,CHTYP,AT IME | |
271 | Q | |
272 | FIXMO ; | |
273 | S ENDMO=$ E(CHDT2,4, 5) | |
274 | I ENDMO=1 0 S STOPMO =1 | |
275 | I ENDMO=1 1 S STOPMO =2 | |
276 | I ENDMO=1 2 S STOPMO =3 | |
277 | I ENDMO=" 01" S STOP MO=4 | |
278 | I ENDMO=" 02" S STOP MO=5 | |
279 | I ENDMO=" 03" S STOP MO=6 | |
280 | I ENDMO=" 04" S STOP MO=7 | |
281 | I ENDMO=" 05" S STOP MO=8 | |
282 | I ENDMO=" 06" S STOP MO=9 | |
283 | I ENDMO=" 07" S STOP MO=10 | |
284 | I ENDMO=" 08" S STOP MO=11 | |
285 | I ENDMO=" 09" S STOP MO=12 | |
286 | Q | |
287 | HEAD ; | |
288 | S X=DT D DTPRT S DA TE=Y,PG=1, X=$P($H,", ",2),H=X\3 600,M=X#36 00\60 | |
289 | S:M<10 M= 0_M S:H<10 H=0_H S T IME=H_M | |
290 | U FIO W D UZ," HEALTH ADM INISTRATIO N CENTER " ,! | |
291 | S X=DT D DTPRT S DA TE=Y | |
292 | S X=$P($H ,",",2),H= X\3600,M=X #3600\60 | |
293 | ;S:M<10 M =0_M S:H<1 0 H=0_H S TIME=H_MHE AD | |
294 | ; | |
295 | I CHPGTYP ="1" S HDT ITLE="CHAM PVA AI Sav ings" | |
296 | ;I CHPGTY P="CHF" S HDTITLE="C HAMPVA For eign AI Sa vings" | |
297 | ;I CHPGTY P="FMP" S HDTITLE="F oreign Med ical Progr am AI Savi ngs" | |
298 | ;I CHPGTY P="PGW" S HDTITLE="P ersian Gul f Program AI Savings " | |
299 | I CHPGTYP ="6" S HDT ITLE="Spin a Bifida A I Savings" | |
300 | I CHPGTYP ="7" S HDT ITLE="Chil dren of Wo men Vietna m Vets AI Savings" | |
301 | I CHPGTYP ="A" S HDT ITLE="ALL AI Savings " | |
302 | ; | |
303 | ;W !,?28, "(Not incl uding Clai mCheck)" | |
304 | ;W !!,?80 -$L(DATE)/ 2,DATE | |
305 | S X=CHDT D DTPRT S CHDTP1=Y S X=CHDT2 D DTPRT S C HDTP2=Y | |
306 | U FIO W D ATE," AI SAVINGS REPORT",! | |
307 | ; | |
308 | S T1=$E(T IME,1,2) | |
309 | S T2=$E(T IME,3,4) | |
310 | S TIME=T1 _":"_T2 | |
311 | U FIO W T IME," Report for : "_H DTITLE_" f rom ",CHDT P1_" - "_C HDTP2,! | |
312 | U FIO W ! | |
313 | U FIO W T _T_"Octobe r"_T_"Nove mber"_T_"D ecember"_T _"January" _T_"Februa ry"_T_"Mar ch"_T_"Apr il"_T_"May "_T_"June" _T_"July"_ T_"August" _T_"Septem ber"_T,! | |
314 | Q | |
315 | ; | |
316 | DTPRT S Y= "" Q:X'?7N S Y=$E(X ,1,3)+1700 ,%M=+$E(X, 4,5),%D=+$ E(X,6,7) | |
317 | I %M S:%D Y=$E(" ", $L(%D))_%D _", "_Y S Y=$P($P($T (JAN),";;" ,2)," ",%M )_" "_Y | |
318 | Q | |
319 | JAN ;;JAN FEB MAR AP R MAY JUN JUL AUG SE P OCT NOV DEC | |
320 | SBRS R Y:$ S($D(DTIME ):DTIME,1: 60) | |
321 | I '$T W * 7 R Y:5 G SBRS:Y="." S:'$T Y=I OZFO | |
322 | SBRS1 K DF OUT,DUOUT, DQOUT S:'$ D(IOZFO) I OZFO="^^" S:'$D(IOZB K) IOZBK=" ^" | |
323 | I IOZFO=Y W:$D(IOZF ) # S (DFO UT,Y)="" Q | |
324 | S:Y=IOZBK (DUOUT,Y) ="" S:Y?1" ?".E!(Y["^ ") (DQOUT, Y)="" | |
325 | FMJUL(FDT) ;CONVERT FM DATE TO JULIAN DA TE | |
326 | N D1,D2,D 3 | |
327 | I '$D(FDT ) S FDT=DT | |
328 | S X=$E(FD T,1,3)_"00 00" D H^%D TC S D2=%H | |
329 | S X=FDT D H^%DTC S D1=%H | |
330 | ;MTN01347 1 JSE - 10 /28/11 FIX UNDEF ERR OR FMJUL+5 | |
331 | ;S D3=D1- D2+1 S:D3< 100 D3="0" _D3 S:D3<1 0 D3="0"_D | |
332 | S D3=D1-D 2+1 S:D3<1 00 D3="0"_ D3 S:D3<10 D3="0"_D3 | |
333 | S D3=$E(F DT,2,3)_D3 | |
334 | Q D3 | |
335 | Q | |
336 | STOPIT ; | |
337 | W !,"NO DATA FOUND FOR THIS SEARCH!!!" Q | |
338 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.