Produced by Araxis Merge on 11/9/2018 12:34:07 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 | CHMR85.m | Mon Nov 5 16:44:37 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMR85.m | Mon Nov 5 17:51:07 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 396 |
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 | CHMR85 ;CV A/AEB;SHOW CLAIMS WI TH REJ 85 FOR PERIOD ;01/28/09 11:11 AM | |
2 | ;;V1.0 | |
3 | ;;DEV0165 54-05 YJK Mar 2014 | |
4 | ;;DEV0128 93-08 YJK Mar 2014 | |
5 | ;;DEV0128 93-08 YJK Aug 2015 | |
6 | A1 ;; DEV 006891 | |
7 | ;CHBEG - DATE TO GE T FIRST PD I | |
8 | ;CHEND - LAST DATE TO COUNT | |
9 | D CHDT ; GET DATE R ANGE | |
10 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1) | |
11 | I CHUCI=" HAC" D | |
12 | .S FIO="H AC_HFS$:[S CR.TEMP_FI LES]DATA85 RPT"_$E(CH BEG,2,7)_" TO"_$E(CHE ND,2,7)_". XLS" | |
13 | .W !,"DAT A WILL BE WRITTEN TO ",FIO | |
14 | .Q | |
15 | I CHUCI'= "HAC" D | |
16 | .S FIO="H AC_HFS$:[D SMMANAG.CH AMPVA]DATA 85_RPT_"_$ E(CHBEG,2, 7)_"_TO_"_ $E(CHEND,2 ,7)_".DAT" | |
17 | .S QAFILE ="HAC_HFS$ :[DSMMANAG .CHAMPVA]D ATA85_"_$E (CHBEG,2,7 )_"_TO_"_$ E(CHEND,2, 7)_".DAT" | |
18 | .W !,"DAT A WILL BE WRITTEN TO ",FIO | |
19 | .W !,"QA DATA WILL BE WRITTEN TO ",QAFI LE | |
20 | .Q | |
21 | G:$D(DTOU T) END G:X ="^" END G :X="^^" EN D G:X="" E ND | |
22 | S CHFIO=" " ; SET TH E DEVICE I NTO FUTURE IO VARIAB LE, CHFIO | |
23 | S ZTRTN=" CALC^CHMR8 5" ; ZTRTN IS THE VA RIABLE OF CALC ROUTI NE TO QUE | |
24 | S ZTDESC= "TEST Q/C/ P" ; ZTDES C IS SHORT DESCRIPTI ON OF PROC ESS | |
25 | S ZTIO="" ; CURRENT IO DEVICE SET TO NI L SO DEVIC E NOT TIED UP | |
26 | S ZTSAVE( "CHFIO")=" ",ZTSAVE(" CHBEG")="" ,ZTSAVE("C HEND")="" | |
27 | S ZTSAVE( "FIO")="" | |
28 | D ^%ZTLOA D ; CALLS TASK MAN W ITH VARIAB LES IT NEE DS | |
29 | ;D CALC^C HMR85 | |
30 | END Q | |
31 | CHDT ; | |
32 | I '$D(DT) D NOW^%DT C S DT=X | |
33 | I DT="" D NOW^%DTC S DT=X | |
34 | S CHDEF1= $$FYR^CHTF LIB(DT) S CHDEF="10/ 01/"_$E(CH DEF1,2,3) | |
35 | S %DT="AE ",%DT("A") ="Enter a START date : ",%DT(" B")=$$FMTE ^XLFDT(CHD EF,"5D") D ^%DT | |
36 | Q:$D(DTOU T) Q:X="^ " Q:X="^^ " Q:X="" | |
37 | I Y=-1 D G CHDT | |
38 | .U 0 W !! ,"NOT A VA LID DATE" Q | |
39 | S CHBEG=Y K %DT | |
40 | S CHDEF1= $$FMADD^XL FDT(CHBEG, 365,0,0,0) S CHDEF=" 09/30/"_$E (CHDEF1,2, 3) | |
41 | CHDT1 S %D T="AE",%DT ("A")="Ent er an END date: ",% DT("B")=$$ FMTE^XLFDT (CHDEF,"5D ") D ^%DT | |
42 | Q:$D(DTOU T) G:X="^ " CHDT Q:X ="^^" G:X ="" CHDT | |
43 | I Y=-1 D G CHDT1 | |
44 | .U 0 W !! ,"NOT A VA LID DATE" Q | |
45 | S CHEND=Y K %DT | |
46 | Q | |
47 | CALC ; | |
48 | S CHBEG1= $$FMADD^XL FDT(CHBEG, -60,0,0,0) | |
49 | S CHEND1= $$FMADD^XL FDT(CHEND, 60,0,0,0) | |
50 | S X1=$$FM JUL^CHTFLI B(CHBEG1) | |
51 | S X2=$$FM JUL^CHTFLI B(CHEND1) | |
52 | ;NEXT 2 L INES NEW S TART AND E ND DATES | |
53 | ;S X1=$$F MJUL(STRDT ) | |
54 | ;S X2=$$F MJUL(ENDDT ) | |
55 | ; 13 Digi t PDI Loop | |
56 | I CHBEG<3 000000 D Q | |
57 | .S PDI=X1 _"00000000 " | |
58 | .S PDI2=X 2_"9999999 9" | |
59 | .S:CHEND1 >3000000 P DI2=$$CEN2 ^CHMFPDI2( X2)_X2_"99 999999" | |
60 | .D CALC2 | |
61 | .Q | |
62 | ; 15 digi t PDI Loop | |
63 | S PDI=$$C EN2^CHMFPD I2(X1)_X1_ "00000000" | |
64 | S PDI2=$$ CEN2^CHMFP DI2(X2)_X2 _"99999999 " | |
65 | ; | |
66 | D CALC2 | |
67 | K BFN,DFN ,CHBNAME,C HBREL,CHBS SN,CHCMPDT ,CHDEF,CHD EF1 | |
68 | K CHEXT,C HGENDER,CH PDAMT,CHPD IDT,CHPDIP T,CHPRGM,C HPTYP,CHRE L | |
69 | K CHSYS,C I,CREC0,PG ,X,X1,X2,B RE0,C1REC, CHBDOB,CHB EG,CHBEG1, CHEND | |
70 | K CHEND1, CHFMPCDT,C HPRPT,CHUC IPT,CLNUM, JJ,PDI,PDI 2,PDIDT,SR EC0,Y | |
71 | Q | |
72 | ; | |
73 | CALC2 ;PG- PAGE COUN TS | |
74 | ;PDI - PD I TO START WITH | |
75 | ;PDI2 - L AST PDI TO COUNT | |
76 | ;CI-CLAIM POINTER | |
77 | ;CHTOS= C LAIM TYPE OF SERVICE | |
78 | ;CHPDAMT CLAIM PAID AMOUNT | |
79 | ;CHDTOD - INPATIENT DATE OF D ISCHARGE | |
80 | ;CHDOS - DATE OF SE RVISE (DAT E OF ADMIS SION FOR I NPATIENT C LAIMS) | |
81 | ;CHREL RE LATIONSHIP WITH SPON SOR | |
82 | ;CHDOD - SPONSOR DA TE OF DEAT H | |
83 | ;CHBDOB - BENE DATE OF BIRTH | |
84 | ;CHBAGE B ENE AGE ON THE DATE REPORT RUN S | |
85 | ;CREC- ZE RO NODE OF CLIM FILE | |
86 | ;C1REC - 1 NODE OF CLAIM FILE | |
87 | K ^CHMZHO LD($J,"DAT A_85_RPT") | |
88 | S PG=0 | |
89 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1) | |
90 | CALC21 S P DI=$O(^CHM PAY("C",PD I)) G:(PDI >PDI2)!'PD I PQUE | |
91 | S PDIDT=$ E(PDI,1,5) | |
92 | I $L(PDI) >13 S PDID T=$E(PDI,3 ,7) | |
93 | S CHPDIDT =$$JULFM^C HTFLIB(PDI DT) | |
94 | S CI=0 | |
95 | CALC3 S CI =$O(^CHMPA Y("C",PDI, CI)) G:'CI CALC21 | |
96 | K WFLG S CHPDAMT=0 | |
97 | I '$D(^CH MPAY(CI,0) ) G CALC3 | |
98 | ;BELOW CO DE TO ACCO UNT FOR A CLAIM WITH MULTIPLE PDI'S EX - 58225225 | |
99 | I $D(^CHM PAY(CI,"AR CHIVE")) G CALC3 | |
100 | S CHPDIPT =999,CHPDI PT=$O(^CHM PAY(CI,"PD I",CHPDIPT ),-1) G:'$ D(^CHMPAY( CI,"PDI",C HPDIPT,0)) CALC21 | |
101 | G:$P(^CHM PAY(CI,"PD I",CHPDIPT ,0),"^",1) >PDI2 CALC 3 | |
102 | S X1=CI D PROGTYP^C HFCD001 | |
103 | S CHPTYP= $P(^CHMDIC (741002.94 ,CHPGPT,0) ,"^",5) ; PROGRAM TY PE | |
104 | S CHPRGM= $P(^CHMDIC (741002.94 ,CHPGPT,0) ,"^",2) | |
105 | S CREC0=^ CHMPAY(CI, 0) ;SKIP IF NO CLAI M FILE ZER O NODE | |
106 | G:$P(CREC 0,"^",13)= 85 CALC31 ;SKIP IF NO EOB REA SON OF 85 | |
107 | D EOB I ' $D(CH85FLG ) G CALC3 ;CHK FOR EOB REASON 85 | |
108 | K CH85FLG | |
109 | I $P(CREC 0,"^",2)'= 4 G CALC3 | |
110 | CALC31 S C HCMPDT=$P( CREC0,"^", 10) G:CHCM PDT="" CAL C3 | |
111 | G:(CHCMPD T>CHEND)!( CHCMPDT<CH BEG) CALC3 ;SKIP- C OMPLETED O UTSIDE OF RANGE | |
112 | S CHCLMNM =$P(CREC0, "^",1) | |
113 | S CHDOS=$ P(CREC0,"^ ",8) | |
114 | S CHVPT=$ P(CREC0,"^ ",3) G:CHV PT="" CALC 3 ;SKIP I F NO VENDO R POINTER | |
115 | I '$D(^CH MVEN(CHVPT ,0)) G CAL C3 ;SKIP IF NO VEND OR | |
116 | S CHVEN0= ^CHMVEN(CH VPT,0) | |
117 | S CHVTAXI D=$P(CHVEN 0,"^",3) | |
118 | I '$D(^CH MPAY(CI,1) ) G CALC3 ;NO PAYME NT NODES - SKIP | |
119 | S C1REC=^ CHMPAY(CI, 1) | |
120 | S CHVPDAM T=$P(C1REC ,"^",14) | |
121 | S:CHCMPDT '="" CHCMP DT=$$FMTE^ XLFDT(CHCM PDT,"5D") | |
122 | S ^CHMZHO LD($J,"DAT A_CALL_85" ,CHPRGM,CI )=CHCLMNM_ U_CHPRGM_U _$$FMTE^XL FDT(CHDOS, "5D")_U_CH CMPDT_U_CH VPDAMT_U_C HVTAXID_U_ PDI | |
123 | I CHUCI'= "HAC" D | |
124 | .S ^CHMZH OLD($J,"QA DATA_85",C I)=CHVPT_U _CHCMPDT | |
125 | .Q | |
126 | G CALC3 | |
127 | PQUE ; | |
128 | D PRSTART ^CHMR85 | |
129 | ;K ^CHMZH OLD($J,"DA TA_CALL_85 ") | |
130 | Q | |
131 | ; | |
132 | HEAD ; | |
133 | D NOW^%DT C S TIME=$ E($P(%,"." ,2),1,4) | |
134 | S DATE=$$ FMTE^XLFDT (X,"2D") | |
135 | U FIO W D UZ_U_"HEAL TH ADMINIS TRATION CE NTER" | |
136 | U FIO W !,TI ME_U_"AMOU NT APPLIED TO OUTSTA NDING INDE BTEDNESS C ODE 85 REP ORT",!,DAT E | |
137 | U FIO W !,U_ "FROM "_U_ $$FMTE^XLF DT(CHBEG," 5D")_U_" TO "_U_$$ FMTE^XLFDT (CHEND,"5D "),!! | |
138 | Q | |
139 | PRSTART ; | |
140 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1) | |
141 | X "D $SYS TEM.Proces s.SetZEOF( 1)" ;DEV 016554-05 YJK Aug 20 15 | |
142 | ;O FIO C FIO:"D" ;DEV 016554-05 YJK Mar 20 14 | |
143 | ;O FIO:"N WS" ;DEV 016554-05 YJK Mar 20 14 | |
144 | S X=$ZF(- 1,"DELETE "_FIO_";*" ) ;DEV 016554-05 YJK Mar 20 14 | |
145 | G:'$$OPEN FIWR^CHTFL IB9(.FIO," FIO") PREN D ;DEV 016554-05 YJK Mar 20 14 | |
146 | S T=$C(9) | |
147 | S PG=0,CH TOT=0 D HE AD | |
148 | I '$D(^CH MZHOLD($J, "DATA_CALL _85")) D G PREND | |
149 | .U FIO U FIO W !,"N O DATA FOU ND" | |
150 | .Q | |
151 | S CHPRTP= "" | |
152 | PRS1 S CHP RTP=$O(^CH MZHOLD($J, "DATA_CALL _85",CHPRT P)) G:CHPR TP="" PREN D | |
153 | S CHCLMPT =0 | |
154 | PRS2 S CHC LMPT=$O(^C HMZHOLD($J ,"DATA_CAL L_85",CHPR TP,CHCLMPT )) G:'CHCL MPT PRS1 | |
155 | G:'$D(^CH MZHOLD($J, "DATA_CALL _85",CHPRT P,CHCLMPT) ) PRS2 | |
156 | S CHCLMNM =$P(^CHMZH OLD($J,"DA TA_CALL_85 ",CHPRTP,C HCLMPT),"^ ",1) | |
157 | S CHPROG= $P(^CHMZHO LD($J,"DAT A_CALL_85" ,CHPRTP,CH CLMPT),"^" ,2) | |
158 | S CHDOS=$ P(^CHMZHOL D($J,"DATA _CALL_85", CHPRTP,CHC LMPT),"^", 3) | |
159 | S CHCOMPD T=$P(^CHMZ HOLD($J,"D ATA_CALL_8 5",CHPRTP, CHCLMPT)," ^",4) | |
160 | S CHVENPD =$P(^CHMZH OLD($J,"DA TA_CALL_85 ",CHPRTP,C HCLMPT),"^ ",5) | |
161 | S CHVTAXI D=$P(^CHMZ HOLD($J,"D ATA_CALL_8 5",CHPRTP, CHCLMPT)," ^",6) | |
162 | S CHPDI=$ P(^CHMZHOL D($J,"DATA _CALL_85", CHPRTP,CHC LMPT),"^", 7) | |
163 | U FIO W ! ,CHPDI_U_C HCLMNM_U_C HPROG_U_CH DOS_U_CHCO MPDT_U_CHV ENPD_U_CHV TAXID | |
164 | G PRS2 | |
165 | ; | |
166 | PREND ; | |
167 | ;C FIO ;DEV016554 -05 YJK Ma r 2014 | |
168 | D CLOSEF^ CHTFLIB9(F IO,"FIO") ;DEV016554 -05 YJK Ma r 2014 | |
169 | X "D $SYS TEM.Proces s.SetZEOF( 0)" ;DEV016554 -05 YJK Au g 2015 | |
170 | ;I CHUCI' ="HAC" D C QAFILE ;DEV016554 -05 YJK Ma r 2014 | |
171 | I CHUCI'= "HAC" D D CLOSEF^CH TFLIB9(QAF ILE,"QAFIL E") X "D $ SYSTEM.Pro cess.SetZE OF(0)" ;DEV01655 4-05 YJK M ar 2014 ;D EV016554-0 5 YJK Aug 2015 | |
172 | .X "D $SY STEM.Proce ss.SetZEOF (1)" ; DEV016554- 05 YJK Aug 2015 | |
173 | .S QAFILE ="HAC_HFS$ :[DSMMANAG .CHAMPVA]Q ADATA85_"_ $E(CHBEG,2 ,7)_"_TO_" _$E(CHEND, 2,7)_".DAT " | |
174 | .;O QAFIL E C QAFILE :"D" ; DEV016554- 05 YJK Mar 2014 | |
175 | .;O QA FILE:"NWS" ;DEV0165 54-05 YJK Mar 2014 | |
176 | .S X=$ ZF(-1,"DEL ETE "_QAFI LE_";*") ;DEV0165 54-05 YJK Mar 2014 | |
177 | .Q:'$$OPE NFIWR^CHTF LIB9(.QAFI LE,"QAFILE ") ; DEV016554- 05 YJK Mar 2014 | |
178 | .S CHCLMP T=0 | |
179 | PRE1 .S CH CLMPT=$O(^ CHMZHOLD($ J,"QADATA_ 85",CHCLMP T)) Q:'CHC LMPT | |
180 | .S WRREC= ^CHMZHOLD( $J,"QADATA _85",CHCLM PT) | |
181 | .U QAFILE W !,$P(^C HMPAY(CHCL MPT,0),"^" ,1)_T_$P(W RREC,"^",1 )_T_$P(WRR EC,"^",2) | |
182 | .G PRE1 | |
183 | ;I CHUCI= "HAC" S X= $ZF(-1,"SU BMIT HAC_H FS$:[SCR.T EMP_FILES] REC_COPY.C OM/PARAM=( """_FIO_"" ""_")") | |
184 | I CHU CI="HAC" D ;DEV01 2893-08 YJ K Mar 2014 | |
185 | .S FO LDER="/FS3 BIG" ;DEV01 2893-08 YJ K Mar 2014 | |
186 | .D FTPFILE ^CHTFLIB9( FIO," DNS fs3. DNS ",FOLDER," PUT") ;DEV012893 -08 YJK Ma r 2014 | |
187 | .S X= $ZF(-1,"DE LETE "_FIO _";*") ;DEV01 2893-08 YJ K Mar 2014 | |
188 | .Q ;DEV01 2893-08 YJ K Mar 2014 | |
189 | K CHUCI,F IO,CHDOD,C HAGE,CHTOT ,PG,WRREC, CHCLMPT,QA FILE,T | |
190 | ;K ^CHMZH OLD($J,"DA TA_CALL_85 ") | |
191 | Q | |
192 | EOB ; | |
193 | Q:'CI K CH85FLG | |
194 | S CHEOBRP T=0 | |
195 | EOB1 S CHE OBRPT=$O(^ CHMPAY(CI, 4,CHEOBRPT )) Q:'CHEO BRPT | |
196 | G:'$D(^CH MPAY(CI,4, CHEOBRPT,0 )) EOB1 S EOBREJ=^CH MPAY(CI,4, CHEOBRPT,0 ) | |
197 | I $P(EOBR EJ,"^",1)' =85 G EOB1 | |
198 | I $P(EOBR EJ,"^",1)= 85 S CH85F LG="" Q | |
199 | G EOB1 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.