Produced by Araxis Merge on 11/9/2018 12:33:41 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 | CHBPR5.m | Mon Nov 5 16:39:18 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHBPR5.m | Tue Nov 6 21:55:12 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 5 | 444 |
Changed | 4 | 8 |
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 | CHBPR5 ;CV A/JEH;SUMM ARY OF CLA IMS SENT T O AAC REPO RT;06/05/9 6 8:57 AM | |
2 | ;;1.0 | |
3 | ;DEF01655 4 SBB 11/2 2/13 - Mod ified Writ ing to a f ile as per VHA stand ard. | |
4 | ;DEF01655 4 SBB 07/3 0/15 - Add ing change s for DECN ET | |
5 | ; | |
6 | ;END00060 2 - | |
7 | ;THIS REP ORT IS TO DETERMINE THE NUMBER AND PAYME NT AMOUNT | |
8 | ;OF CLAIM S THAT ARE REJECTED BY THE AAC BETWEEN A DATE | |
9 | ;RANGE EN TERED BY T HE USER. | |
10 | ; | |
11 | ZSET S:'$D (DUZ) DUZ= 1,DUZ(0)=" " I '$D(DT ) S %DT="" ,X="T" D ^ %DT S DT=Y | |
12 | S:'$D(IOZ FO) IOZFO= "^^" S:'$D (IOZBK) IO ZBK="^" S: '$D(DTIME) DTIME=60 | |
13 | I '$D(IOZ ) S %IS="N ",IOP=$I D ^%ZIS K I OP S IOZ=I O,IOZL=IOS L,IOZW=IOM ,IOZF=IOF, IOZT=IOST, IOZN=ION,I OZS=IOS | |
14 | ZNAM ; | |
15 | ; | |
16 | START ; | |
17 | D INIT | |
18 | Q:Y=""!(Y ="^") | |
19 | D QUEA | |
20 | Q | |
21 | TSKMN ; | |
22 | D CALC | |
23 | D OUTPT | |
24 | G END | |
25 | Q | |
26 | INIT ; INI TIALIZE VA RIABLES | |
27 | K ^CHMZHO LD("FYPAY" ) ; HOLD ING GLOBAL FOR CLAIM S SENT TO AAC DATA | |
28 | S PGCTR=0 ; PAGE N UMBER ON R EPORT | |
29 | ;DISPLAY MENU TITLE | |
30 | W @IOF,?3 0,"Summary of Claims Sent to A AC",! | |
31 | S1 ;SET ST ART DATE | |
32 | K STOP | |
33 | S (STRTDA TE,DTHDRS) ="" K DIR | |
34 | S DIR("T" )=15 | |
35 | S DIR(0)= "D" S DIR( "A")="Ente r START da te (mm/dd/ yyyy)" D ^ DIR K DIR | |
36 | Q:$D(DTOU T) | |
37 | I Y>DT W !,"The sta rt date ca nnot be gr eater than the curre nt system date." G S 1 | |
38 | S STRTDAT E=Y | |
39 | S DTHDRS= $E(Y,4,5)_ "/"_$E(Y,6 ,7)_"/"_$$ FMYR^CHTFL IB(Y) | |
40 | I STRTDAT E="^" S ST OP="" Q:$D (STOP) | |
41 | G:STRTDAT E="" S1 | |
42 | E1 ;SET EN D DATE | |
43 | K STOP | |
44 | S ENDDATE ="" | |
45 | S DIR("T" )=15 | |
46 | S DIR(0)= "D" S DIR( "A")="Ente r END date (mm/dd/yy yy)" D ^DI R K DIR | |
47 | G:$D(DTOU T) S1 | |
48 | I Y>DT W !,"The end date cann ot be grea ter than t he current system da te." G E1 | |
49 | S (ENDDAT E,DTHDRE)= Y | |
50 | S DTHDRE= $E(Y,4,5)_ "/"_$E(Y,6 ,7)_"/"_$$ FMYR^CHTFL IB(Y) | |
51 | I ENDDATE ="^" S STO P="" G S1 | |
52 | G:ENDDATE ="" E1 | |
53 | I ENDDATE <STRTDATE W !,"The e nd date ca nnot be le ss than th e Start da te." G E1 | |
54 | ;INITIALI ZING ARRAY | |
55 | S I=0 F S I=$O(^CH MDIC(74100 2.93,"C",I )) Q:'I D | |
56 | .S ^CHMZH OLD($J,"FY PAY","ACC" ,"TOT",I)= 0 | |
57 | .S ^CHMZH OLD($J,"FY PAY","ACC" ,"AMT",I)= 0 | |
58 | .S ^CHMZH OLD($J,"FY PAY","REJ" ,"TOT",I)= 0 | |
59 | .S ^CHMZH OLD($J,"FY PAY","REJ" ,"AMT",I)= 0 | |
60 | S ^CHMZHO LD($J,"FYP AY","ACC", "TOT",999) =0 | |
61 | S ^CHMZHO LD($J,"FYP AY","ACC", "AMT",999) =0 | |
62 | S ^CHMZHO LD($J,"FYP AY","REJ", "TOT",999) =0 | |
63 | S ^CHMZHO LD($J,"FYP AY","REJ", "AMT",999) =0 | |
64 | W ! | |
65 | D ENVIR | |
66 | G:Y=""!(Y ="^") E1 | |
67 | Q | |
68 | CALC ; CAL CULATE NUM BER AND PA YMENT AMOU NTS OF CLA IMS | |
69 | S I=STRTD ATE F S I =$O(^CHMSN A(741008.2 6,I)) Q:'I !(I>ENDDAT E) D | |
70 | .Q:'$D(^C HMSNA(7410 08.26,I,10 0)) | |
71 | .S J=0 F S J=$O(^C HMSNA(7410 08.26,I,10 0,J)) Q:'J D | |
72 | ..Q:'$D(^ CHMSNA(741 008.26,I,1 00,J,0)) | |
73 | ..Q:$P(^C HMSNA(7410 08.26,I,10 0,J,0),"^" ,3)="" | |
74 | ..S (ACRJ ,CHCLM,CHA MT)="" | |
75 | ..S ACRJ= $P(^CHMSNA (741008.26 ,I,100,J,0 ),"^",2) ; ACCEPT /REJECT | |
76 | ..S CHCLM =$E($P($P( ^CHMSNA(74 1008.26,I, 100,J,0)," ^",4),"/", 1),4,10) ; CLAIM | |
77 | ..Q:CHCLM =""!(CHCLM =" ") | |
78 | ..S CHCLP T=0 S CHCL PT=$O(^CHM PAY("B",CH CLM,CHCLPT )) | |
79 | ..I CHCLP T'="" D | |
80 | ...I $D(^ CHMPAY(CHC LPT,"PDI", 1,0)) D | |
81 | ....I $L( $P(^CHMPAY (CHCLPT,"P DI",1,0)," ^",1))=15 D | |
82 | .....S CH PRG=$E($P( ^CHMPAY(CH CLPT,"PDI" ,1,0),"^", 1),8,9) | |
83 | ....E S CHPRG=$E($ P(^CHMPAY( CHCLPT,0), "^",4),6,7 ) | |
84 | ...E D | |
85 | ....I CHC LPT'="" D | |
86 | .....I $L ($P($P(^CH MPAY(CHCLP T,0),"^",4 ),"*",1))= 15 D | |
87 | ......S C HPRG=$E($P (^CHMPAY(C HCLPT,0)," ^",4),8,9) | |
88 | .....E S CHPRG=$E( $P(^CHMPAY (CHCLPT,0) ,"^",4),6, 7) | |
89 | ..S:CHCLP T=""!(CHPR G="") CHPR G=999 | |
90 | ..S:'$D(^ CHMZHOLD($ J,"FYPAY", "ACC","AMT ",CHPRG)) CHPRG=999 | |
91 | ..S CHAMT =$P(^CHMSN A(741008.2 6,I,100,J, 0),"^",5) ; CLAIM AMOUNT | |
92 | ..Q:$D(^C HMZHOLD($J ,"FYPAY",C HCLM)) | |
93 | ..S ^CHMZ HOLD($J,"F YPAY",CHCL M)=ACRJ_"^ "_CHAMT_"^ "_I_"^"_J | |
94 | ..I ACRJ= "A" D | |
95 | ...S ^CHM ZHOLD($J," FYPAY","AC C","TOT",C HPRG)=^CHM ZHOLD($J," FYPAY","AC C","TOT",C HPRG)+1 | |
96 | ...S ^CHM ZHOLD($J," FYPAY","AC C","AMT",C HPRG)=^CHM ZHOLD($J," FYPAY","AC C","AMT",C HPRG)+CHAM T | |
97 | ..I ACRJ= "R" D | |
98 | ...S ^CHM ZHOLD($J," FYPAY","RE J","TOT",C HPRG)=^CHM ZHOLD($J," FYPAY","RE J","TOT",C HPRG)+1 | |
99 | ...S ^CHM ZHOLD($J," FYPAY","RE J","AMT",C HPRG)=^CHM ZHOLD($J," FYPAY","RE J","AMT",C HPRG)+CHAM T | |
100 | Q | |
101 | OUTPT ; GE NERATE TEX T FILE | |
102 | D RPTDATA | |
103 | D RPTHDR | |
104 | S GTACNUM =0 ; GR AND TOTAL FOR NUMBER OF ACCEPT ED CLAIMS | |
105 | S GTACAMT =0 ; GR AND TOTAL FOR AMOUNT OF ACCEPT ED CLAIMS | |
106 | S GTRJNUM =0 ; GR AND TOTAL FOR NUMBER OF REJECT ED CLAIMS | |
107 | S GTRJAMT =0 ; GR AND TOTAL FOR AMOUNT OF ACCEPT ED CLAIMS | |
108 | ; | |
109 | ;S I=0 F S I=$O(^C HMDIC(7410 02.93,"C", I)) Q:'I D ; USE THIS FOR ALL PR OGRAMS | |
110 | F I="03", 60,70,10," 09" D ; USE FOR C HAMPVA (03 ), SB (12) , CWVV (18 ), FMP (10 ), PGP (09 ) | |
111 | .S J=0 S J=$O(^CHMD IC(741002. 93,"C",I,J )) | |
112 | .S CHPRGN M="" S CHP RGNM=$P(^C HMDIC(7410 02.93,J,0) ,"^",1) | |
113 | .S:J=1 CH PRGNM="CHA MPVA" ; CHAMPVA ST ANDARD | |
114 | .S:J=9 CH PRGNM="PGP " ; PERSIAN GU LF PROGRAM | |
115 | .S:J=10 C HPRGNM="FM P" ; FOREIGN ME DICAL PROG RAM | |
116 | .S:J=12 C HPRGNM="SB " ; SPINA BIFI DA | |
117 | .S:J=18 C HPRGNM="CW VV" ; CHILDREN O F WOMEN VI ETNAM VET | |
118 | .S CHPRG= I | |
119 | .S GTACNU M=GTACNUM+ ^CHMZHOLD( $J,"FYPAY" ,"ACC","TO T",CHPRG) | |
120 | .S GTACAM T=GTACAMT+ ^CHMZHOLD( $J,"FYPAY" ,"ACC","AM T",CHPRG) | |
121 | .S GTRJNU M=GTRJNUM+ ^CHMZHOLD( $J,"FYPAY" ,"REJ","TO T",CHPRG) | |
122 | .S GTRJAM T=GTRJAMT+ ^CHMZHOLD( $J,"FYPAY" ,"REJ","AM T",CHPRG) | |
123 | . | |
124 | .W !,CHPR GNM,?16,$J (^CHMZHOLD ($J,"FYPAY ","ACC","T OT",CHPRG) ,8),?29,"$ ",$J(^CHM ZHOLD($J," FYPAY","AC C","AMT",C HPRG),10,2 ) | |
125 | .W ?47,$J (^CHMZHOLD ($J,"FYPAY ","REJ","T OT",CHPRG) ,8),?60,"$ ",$J(^CHM ZHOLD($J," FYPAY","RE J","AMT",C HPRG),10,2 ) | |
126 | ; | |
127 | ;GRAND TO TALS | |
128 | W !!,?5," Total:",?1 6,$J(GTACN UM,8),?29, "$ ",$J(GT ACAMT,10,2 ),?47,$J(G TRJNUM,8), ?60,"$ ",$ J(GTRJAMT, 10,2),! | |
129 | ; | |
130 | ;USE THE NEXT 3 LIN ES TO PRIN T CLAIMS N OT IN A PR OGRAM - FO R FUTURE U SE | |
131 | ;S CHPRG= 999 ;CLAIMS NOT IN ^CH MDIC(74100 2.93 | |
132 | ;W !,"OTH ER",?16,^C HMZHOLD($J ,"FYPAY"," ACC","TOT" ,CHPRG),?2 9,"$",?31, ^CHMZHOLD( $J,"FYPAY" ,"ACC","AM T",CHPRG) | |
133 | ;W ?47,^C HMZHOLD($J ,"FYPAY"," REJ","TOT" ,CHPRG),?6 0,"$ ",^CH MZHOLD($J, "FYPAY","R EJ","AMT", CHPRG) | |
134 | Q | |
135 | RPTDATA ; DATES FOR REPORT | |
136 | ;DEF01655 4, SBB, 11 /22/13 - G et UCI so this can b e tested i n all area s. | |
137 | N IOF,UCI | |
138 | S IOF="#, *27,*91,*5 0,*74,*27, *91,*72" | |
139 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) | |
140 | ;S IO="HA CFS3"" DNS HACdec741! ""::D:[FS3 BIG.FISCAL ]"_RNAME_" .TXT" | |
141 | S FS3FOLD ER="/FS3BI G/FISCAL" | |
142 | S RIO="HA C_HFS$:[SC R.TEMP.FIL ES]"_RNAME _".TXT" | |
143 | I UCI'="H AC" S RIO= "HAC_HFS$: [DSMMANAG. CHAMPVA]"_ RNAME_"_"_ UCI_".TXT" | |
144 | ;O IO:"NW S":5 | |
145 | ;SBB 07/3 0/15 DEF01 6554 | |
146 | X "D $SYS TEM.Proces s.SetZEOF( 1)" | |
147 | I '$$OPEN FIRD^CHTFL IB9(.RIO," RIO") G EN D | |
148 | U RIO | |
149 | D NOW^%DT C S XDT=% | |
150 | S RNDT=$P (XDT,".",1 ) | |
151 | S RUNDT=$ E(RNDT,4,5 )_"/"_$E(R NDT,6,7)_" /"_$$FMYR^ CHTFLIB(RN DT) | |
152 | S RNTM=$P (XDT,".",2 ) | |
153 | S RUNTM=$ E(RNTM,1,2 )_":"_$E(R NTM,3,4) | |
154 | S H1=DUZ | |
155 | S H2="HEA LTH ADMINI STRATION C ENTER" | |
156 | S H3="Pag e: " | |
157 | S H4=RUND T | |
158 | S H5="SUM MARY OF CL AIMS SENT TO AAC" | |
159 | S H6=RUNT M | |
160 | S H7="REP ORT FROM " _DTHDRS_" TO "_DTHDR E | |
161 | S H8=" AAC ACC EPTED CLAI MS AAC RE JECTED CLA IMS" | |
162 | S H9="PRO GRAM # CLAIM S APPR OVED AMOUN T # CLAI MS REJ ECTED AMOU NT" | |
163 | S LN="" F I=1:1:80 S LN=LN_"- " | |
164 | Q | |
165 | RPTHDR | |
166 | S PGCTR=P GCTR+1 | |
167 | S H3=H3_P GCTR | |
168 | W H1,?(40 -($L(H2)/2 )),H2,?(40 -($L(H2)/2 )),?(80-$L (H3)),H3 | |
169 | W !,H4,?( 40-($L(H5) /2)),H5 | |
170 | W !,H6,?( 40-($L(H7) /2)),H7 | |
171 | W !!,H8 | |
172 | W !,H9 | |
173 | W !,LN | |
174 | Q | |
175 | END ; END OF CHBPR5 | |
176 | ;DEF01655 4-10/30/13 -SBB use S TATUS^%ZIS H to check for EOF | |
177 | ;C IO | |
178 | D CLOSEF^ CHTFLIB9(R IO,"RIO") | |
179 | ;SBB 07/3 0/15 DEF01 6554 | |
180 | X "D $SYS TEM.Proces s.SetZEOF( 0)" | |
181 | D FTPFILE ^CHTFLIB9( RIO," DNS . DNS ",FS3FOLDE R,"PUT") | |
182 | D MMMSG | |
183 | K STRTDAT E,ENDDATE, I,J,ACRJ,C HCLM,CHAMT ,CHPRG,CHA MT | |
184 | Q | |
185 | ; | |
186 | QUEA ;QUE THIS ROUTI NE. | |
187 | ; | |
188 | I '$D(DUZ ) S DUZ=1 | |
189 | S ZTRTN=" TSKMN^CHBP R5" | |
190 | S ZTDESC= "PROCESS C LAIMS TO A AC RPT" | |
191 | S ZTSAVE( "STRTDATE" )="" | |
192 | S ZTSAVE( "ENDDATE") ="" | |
193 | S ZTSAVE( "RNAME")=" " | |
194 | S ZTSAVE( "^CHMZHOLD ($J,""FYPA Y"",")="" | |
195 | S ZTSAVE( "DTHDRS")= "" | |
196 | S ZTSAVE( "DTHDRE")= "" | |
197 | S ZTSAVE( "PGCTR")=" " | |
198 | S ZTSAVE( "DUZ")="" | |
199 | S ZTIO="" | |
200 | D ^%ZTLOA D ; COMMEN T OFF TO R UN HOT | |
201 | Q | |
202 | ENVIR ; | |
203 | ;SET AAC REPORT NAM E | |
204 | S DIR(0)= "F^3:50" | |
205 | S DIR("A" )="Enter S ummary of Claims Sen t to AAC R eport name " D ^DIR K DIR | |
206 | Q:$D(DUOU T) | |
207 | Q:Y="^"!( Y="") | |
208 | S RNAME=Y K DIR | |
209 | W !!,"Rep ort ",RNAM E,".TXT ca n be found in direct ory: DNS /Fs3big/FI SCAL",! | |
210 | Q | |
211 | MMMSG ; ME SSAGE ALER TING REPOR T HAS COMP LETED | |
212 | S CNT=1,^ TMP($J,"PO SS-DUPL-CL MS",CNT)=" ",CNT=CNT+ 1 | |
213 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "********* ********** ********** ********** **",CNT=CN T+1 | |
214 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "** Summar y of Claim Sent to A AC Report **",CNT=CN T+1 | |
215 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "** **",CNT=CN T+1 | |
216 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "** Has CO MPLETED **",CNT=CN T+1 | |
217 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "** **",CNT=CN T+1 | |
218 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "** See DNS /Fs3big/FI SCAL/ **",CNT=CN T+1 | |
219 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "********* ********** ********** ********** **",CNT=CN T+1 | |
220 | S ^TMP($J ,"SUM-AAC- RPT",CNT)= "" | |
221 | S XMTEXT= "^TMP($J," "SUM-AAC-R PT""," | |
222 | S XMDUZ=. 5 | |
223 | S XMY(DUZ )="" | |
224 | S XMSUB=" SUM-AAC-RP T" D ^XMD | |
225 | Q | |
226 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.