Produced by Araxis Merge on 11/9/2018 12:34:05 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 | CHMLPR53.m | Mon Nov 5 16:42:52 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMLPR53.m | Mon Nov 5 17:50:35 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 332 |
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 | CHMLPR53 ; CVA/CR;PRE VAILING FE E/HOLD FIL E;05/25/99 1:20 PM | |
2 | ;;1.0 | |
3 | ;CPTS #16 182 (Y2K) - fixed FN number fo r prevaili ng fee glo bal - CHMS PF | |
4 | ;JEH 3/11 /08 - DEF0 03064 ADD ED '2006' FOR DISPLA Y PURPOSES | |
5 | ;JEH 1/11 /12 - MTN0 14007 ADD ED KILL ST ATEMENTS | |
6 | Z0 W @IOF, !!,"Prevai ling Fee C alculation routine." | |
7 | W !!," Pl ease remem ber that t his routin e MUST be run over a weekend" | |
8 | W !!," an d MUST be coordinate d with IRM ." | |
9 | W !!," Af ter succes sful compl etion of t his calc, the Report can be qu eued." | |
10 | ;W !!,"Pr ess <RETUR N> to cont inue: " D SBRS G QU IT:$D(DFOU T) | |
11 | ;G QUIT:$ D(DUOUT) | |
12 | D CHMDD G QUIT:X="" G Z0:Y=-1 | |
13 | Z1 W !!,"I s this a < F>resh sta rt or a <R >e-start? " D SBRS G QUIT:$D(D FOUT) | |
14 | G QUIT:$D (DUOUT) I $D(DQOUT) W !!?5,"Pl ease enter 'F' or 'R '." G Z1 | |
15 | G QUIT:Y= "" I "FfRr "'[Y W *7, *7,!!?5,"P lease ente r 'F' or ' R'." G Z1 | |
16 | K FLAG I "Ff"[Y D K LGLB G QUE ;JEH 1/ 1/12 ADDED D KLGLB | |
17 | Z2 W !,"En ter claim number on which to r estart: " D SBRS G Q UIT:$D(DFO UT) | |
18 | G QUIT:$D (DUOUT) I $D(DQOUT) W !,"Enter claim num ber on whi ch to star t." G Z2 | |
19 | G QUIT:Y= "" I '$D(^ CHMPAY("B" ,CN)) W !, "That is n ot a valid claim num ber." G Z2 | |
20 | S CN=$O(^ CHMPAY("B" ,Y,0)),CN= CN-1 | |
21 | QUE S ZTRT N="A0^CHML PR53",ZTDT H="",ZTIO= "",ZTSAVE( "CN")="",Z TSAVE("CHM DD")="" | |
22 | S ZTSAVE( "FYRBEG")= "",ZTSAVE( "FYREND")= "",ZTSAVE( "YR")="" | |
23 | S ZTSAVE( "RDATE")=" " | |
24 | D ^%ZTLOA D | |
25 | QUIT Q | |
26 | A0 S KT=0 | |
27 | A1 S CN=$O (^CHMPAY(C N)) G:'CN CALC | |
28 | G A1:'$D( ^(CN,0)) | |
29 | G A1:$D(^ CHMPAY(CN, "ZFI")) | |
30 | S VZIP="" ,KT=KT+1 S :KT#1000=0 ^CHMZHOLD ("RESTART" )=KT_"^"_C N | |
31 | S TYPE=+$ P(^CHMPAY( CN,0),"^", 7) | |
32 | G:TYPE'=2 A1 | |
33 | G:$P(^CHM PAY(CN,0), "^",2)=0 A 1 | |
34 | S VNUM=+$ P(^(0),"^" ,3),DOS=+$ P(^(0),"^" ,8)\1 | |
35 | G:'VNUM A 1 | |
36 | G:DOS<FYR BEG A1 | |
37 | G:DOS>FYR END A1 | |
38 | I $D(^CHM VEN(VNUM,2 )) S VZIP= $E($P(^(2) ,"^",5),1, 5) | |
39 | I VZIP'?5 N S:$D(^CH MVEN(VNUM, 1)) VZIP=$ E($P(^(1), "^",5),1,5 ) | |
40 | I VZIP'?5 N G A1 | |
41 | D LOOP S J=0 G A1:S MSA="" S S MSA=+SMSA | |
42 | ;I VST S ^CHMZHOLD( "PRVL",VST ,SMSA,"CLA IMNO",CN)= "" | |
43 | A6 S J=$O( ^CHMPAY(CN ,"OPT-PROC ",J)) G A1 :'J,A6:'$D (^(J,0)) | |
44 | G A6:+$P( ^(0),"^",4 ) | |
45 | G A6:'$D( ^CHMPAY(CN ,"RULE-PRO C",J,0)) G A6:$P(^(0 ),"^",1)=0 | |
46 | S SERV=$P (^CHMPAY(C N,"OPT-PRO C",J,0),"^ ",1),CHGAM T=+$P(^(0) ,"^",2) G A6:'SERV,A 6:'CHGAMT | |
47 | K CMACFG D CMAC G:$ D(CMACFG) A6 | |
48 | ;S PRV=0 ;JEH 1/1 1/12 - MTN 014007 | |
49 | ;A65 ; ;JEH 1/11/ 12 - MTN01 4007 | |
50 | ; Y2K fix | |
51 | ;S PRV=$O (^CHMDIC(7 41002.49,2 _YR_0000,P RV)) G A66 :'PRV ;J EH 1/11/12 - MTN0140 07 | |
52 | ;G A6:$D( ^CHMDIC(74 1002.49,2_ YR_0000,PR V,"B",SERV )) ;JEH 1/11/12 - MTN014007 | |
53 | ;S PRV=$O (^CHMDIC(7 41002.49,Y R_"0000",1 ,PRV)) G A 66:'PRV ;JEH 1/11/ 12 - MTN01 4007 | |
54 | ;G A6:$D( ^CHMDIC(74 1002.49,YR _"0000",1, PRV,"B",SE RV)) ;JE H 1/11/12 - MTN01400 7 | |
55 | ;G A65 ;JEH 1/11/ 12 - MTN01 4007 | |
56 | G A6:$D(^ CHMDIC(741 002.49,YR_ "0000",1," B",SERV)) | |
57 | A66 I 'SMS A G A1:'VS T S:'$D(^C HMZHOLD("P RVL",SMSA, VST,SERV,0 )) ^(0)=0 D G A6 | |
58 | .S ^(0)=^ (0)+1,CT=^ (0) S X=CT #30 S:X=0 X=30 S Y=( CT\30)+1 | |
59 | .S:CT#30= 0 Y=Y-1 S $P(^(Y),"^ ",X)=CHGAM T | |
60 | .S ^CHMZH OLD("REC", SERV,VZIP, CHGAMT,SMS A,VST,CN)= "" | |
61 | S:'$D(^CH MZHOLD("PR VL",SMSA,S ERV,0)) ^( 0)=0 S ^(0 )=^(0)+1,C T=^(0) | |
62 | S X=CT#30 S:X=0 X=3 0 S Y=(CT\ 30)+1 S:CT #30=0 Y=Y- 1 | |
63 | S $P(^(Y) ,"^",X)=CH GAMT,^CHMZ HOLD("REC" ,SERV,VZIP ,CHGAMT,SM SA,VST,CN) ="" | |
64 | S:'$D(^CH MZHOLD("PR VL",0,VST, SERV,0)) ^ (0)=0 | |
65 | S ^(0)=^( 0)+1,CT=^( 0) S X=CT# 30 S:X=0 X =30 S Y=(C T\30)+1 | |
66 | S:CT#30=0 Y=Y-1 S $ P(^(Y),"^" ,X)=CHGAMT | |
67 | G A6 | |
68 | CALC S SMS A=0 | |
69 | S:'$D(^CH MZHOLD(CHM DD,0)) ^(0 )="CHAMPVA PREVAILIN G FEE "_$$ FMYR^CHTFL IB(YR)_"^" _CHMDD_"P^ ^" | |
70 | C1 S SMSA= $O(^CHMZHO LD("PRVL", SMSA)) G C ALC2:'SMSA S SERV=0 | |
71 | C2 S SERV= $O(^CHMZHO LD("PRVL", SMSA,SERV) ) G C1:'SE RV S NODE= 0,CT=0 | |
72 | G C2:'$O( ^CHMZHOLD( "PRVL",SMS A,SERV,NOD E)) K ^UTI LITY("SMSA SORT1") | |
73 | I $D(^CHM ZHOLD("PRV L",SMSA,SE RV,0)),+^( 0)<5 K ^CH MZHOLD("PR VL",SMSA,S ERV) G C2 | |
74 | C3 S NODE= $O(^CHMZHO LD("PRVL", SMSA,SERV, NODE)) G C 4:'NODE S Z=^(NODE), L=$L(Z,"^" ) | |
75 | F I=1:1:L I +$P(Z," ^",I) D | |
76 | .S CT=CT+ 1,^UTILITY ("SMSASORT 1",+$P(Z," ^",I),CT)= "" | |
77 | G C3 | |
78 | C4 K ^UTIL ITY("SMSAS ORT2") S J =0,CT=0 | |
79 | F I=1:1 S J=$O(^UTI LITY("SMSA SORT1",J)) Q:'J D | |
80 | .S K=0 F L=1:1 S K= $O(^UTILIT Y("SMSASOR T1",J,K)) Q:'K D | |
81 | ..S CT=CT +1,^UTILIT Y("SMSASOR T2",CT,J)= "" | |
82 | S PCNT80= CT*.8,PCNT 80=PCNT80- .001 | |
83 | S PCNT80= $O(^UTILIT Y("SMSASOR T2",PCNT80 )),DOLAMT= "" | |
84 | S DOLAMT= $O(^UTILIT Y("SMSASOR T2",PCNT80 ,DOLAMT)), I="" | |
85 | S I=$O(^C HMZHOLD(CH MDD,"B",SE RV,I)) | |
86 | I 'I S $P (^(0),"^", 4)=$P(^CHM ZHOLD(CHMD D,0),"^",4 )+1 D | |
87 | .S I=$P(^ (0),"^",4) ,$P(^(I,0) ,"^")=SERV ,^CHMZHOLD (CHMDD,"B" ,SERV,I)=" " | |
88 | S J=$S(SM SA<21:1,SM SA<41:2,SM SA<61:3,SM SA<81:4,1: 5),K=SMSA# 20 | |
89 | S:K=0 K=2 0 I I S L= "" S:$D(^C HMZHOLD(CH MDD,I,J)) L=$P(^(J), "^") D | |
90 | .S $P(L," ,",K)=(DOL AMT\1)_";P ",$P(^(J), "^")=L | |
91 | G C2 | |
92 | CALC2 S VS T=0 | |
93 | D1 S VST=$ O(^CHMZHOL D("PRVL",0 ,VST)) G E ND:'VST S SERV=0 | |
94 | D2 S SERV= $O(^CHMZHO LD("PRVL", 0,VST,SERV )) G D1:'S ERV S NODE =0,CT=0 | |
95 | K ^UTILIT Y("SMSASOR T1") | |
96 | I $D(^CHM ZHOLD("PRV L",0,VST,S ERV,0)),+^ (0)<5 K ^C HMZHOLD("P RVL",0,VST ,SERV) G D 2 | |
97 | D3 S NODE= $O(^CHMZHO LD("PRVL", 0,VST,SERV ,NODE)) G D4:'NODE S Z=^(NODE) ,L=$L(Z,"^ ") | |
98 | F I=1:1:L I +$P(Z," ^",I) D | |
99 | .S CT=CT+ 1,^UTILITY ("SMSASORT 1",+$P(Z," ^",I),CT)= "" | |
100 | G D3 | |
101 | D4 K ^UTIL ITY("SMSAS ORT2") S J =0,CT=0 | |
102 | F I=1:1 S J=$O(^UTI LITY("SMSA SORT1",J)) Q:'J D | |
103 | .S K=0 F L=1:1 S K= $O(^UTILIT Y("SMSASOR T1",J,K)) Q:'K D | |
104 | ..S CT=CT +1,^UTILIT Y("SMSASOR T2",CT,J)= "" | |
105 | S PCNT80= CT*.8,PCNT 80=PCNT80- .001 | |
106 | S PCNT80= $O(^UTILIT Y("SMSASOR T2",PCNT80 )),DOLAMT= "" | |
107 | S DOLAMT= $O(^UTILIT Y("SMSASOR T2",PCNT80 ,DOLAMT)), I="" | |
108 | S I=$O(^C HMZHOLD(CH MDD,"B",SE RV,I)) | |
109 | I 'I S $P (^(0),"^", 4)=$P(^CHM ZHOLD(CHMD D,0),"^",4 )+1 D | |
110 | .S I=$P(^ (0),"^",4) ,$P(^(I,0) ,"^")=SERV ,^CHMZHOLD (CHMDD,"B" ,SERV,I)=" " | |
111 | S J=$S(VS T<21:101,V ST<41:102, VST<61:103 ,1:0),K=VS T#20 G D2: 'J | |
112 | S:K=0 K=2 0 I I S L= "" S:$D(^C HMZHOLD(CH MDD,I,J)) L=$P(^(J), "^") D | |
113 | .S $P(L," ,",K)=(DOL AMT\1)_";P ",$P(^(J), "^")=L | |
114 | G D2 | |
115 | END ; | |
116 | D PRMSG ;JEH MTN0 14007 - AD DED | |
117 | Q | |
118 | SBRS R Y:$ S($D(DTIME ):DTIME,1: 60) | |
119 | I '$T W * 7 R Y:5 G SBRS:Y="." S:'$T Y=I OZFO | |
120 | SBRS1 K DF OUT,DUOUT, DQOUT S:'$ D(IOZFO) I OZFO="^^" S:'$D(IOZB K) IOZBK=" ^" | |
121 | I IOZFO=Y W:$D(IOZF ) @IOZF S (DFOUT,Y)= "" Q | |
122 | S:Y=IOZBK (DUOUT,Y) ="" S:Y?1" ?".E!(Y["^ ") (DQOUT, Y)="" | |
123 | Q | |
124 | LOOP S VST =0,SMSA="Z Z" | |
125 | L1 S VST=$ O(^CHMSMSA ("ZIP",VZI P,VST)) Q: 'VST S CN TY=0 | |
126 | L2 S CNTY= $O(^CHMSMS A("ZIP",VZ IP,VST,CNT Y)) G L1:' CNTY S REV DT=0 | |
127 | L3 S REVDT =$O(^CHMSM SA(VST,1,C NTY,3,REVD T)) G L2:' REVDT,L3:' $D(^(REVDT ,0)) | |
128 | S SMSA=$P (^(0),"^", 2) Q | |
129 | ; | |
130 | CHMDD W !! S %DT("A" )="Enter t he Year to be calcul ated (ie. 2006): ", %DT="AEF" D ^%DT ; JEH 3/11/0 8 -ADDED 2 006 | |
131 | ; Y2K log ic changed to handle new FN fo r CHMSPF a nd new PDI format | |
132 | S YR=$E(Y ,1,3) | |
133 | S RDATE=Y | |
134 | S CHMDD=$ $FNSET^CHF BC2A(Y) | |
135 | S FYRBEG= (YR-2)_"07 01",FYREND =(YR-1)_"0 630" | |
136 | I (YR-2)< 299 D ;29 9 is the y r the pdi was conver ted from 1 3 to 15 di g | |
137 | .S STPDI= $E((YR-2), 2,3)_18000 000000 ; 13 digit P DI | |
138 | E S STPD I=$$FMYR^C HTFLIB(YR- 2)_1800000 0000 ;15 digit PDI | |
139 | S STPDI=$ O(^CHMPAY( "C",STPDI) ) Q:'STPDI S CN=$O( ^CHMPAY("C ",STPDI,0) ) | |
140 | Q | |
141 | CMAC K CMA CFG | |
142 | Q:'$D(^CH MSERV(SERV ,0)) | |
143 | S CODE=$P (^CHMSERV( SERV,0),"^ ",1) | |
144 | Q:CODE="" | |
145 | Q:'$D(^CH MCPF("B",C ODE)) | |
146 | S CMACI=$ O(^CHMCPF( "B",CODE,0 )) | |
147 | Q:'CMACI | |
148 | S DATE=99 99999-DOS | |
149 | I DOS<298 0201 S DAT E=$O(^CHMC PF(CMACI,1 ,DATE)) | |
150 | I DOS>298 0200 S DAT E=$O(^CHMC PF(CMACI,2 97,DATE)) | |
151 | I DATE S CMACFG=1 Q | |
152 | Q | |
153 | KLGLB ;KIL L STATEMEN TS - JEH M TN014007 | |
154 | K ^CHMZHO LD("PRVL") ,^CHMZHOLD ("REC") | |
155 | K ^UTILIT Y("SMSASOR T1"),^UTIL ITY("SMSAS ORT2") | |
156 | Q | |
157 | PRMSG ;SEN D MESSAGE INDICATING PRVL CALC IS COMPLE TE - J EH MTN0140 07 | |
158 | S CNT=1,^ TMP($J,"PR VL-MSG",CN T)="",CNT= CNT+1 | |
159 | S ^TMP($J ,"PRVL-MSG ",CNT)="PR EVAILING C ALC HAS CO MPLETED.", CNT=CNT+1 | |
160 | S ^TMP($J ,"PRE_PRVL -MSG",CNT) ="",CNT=CN T+1 | |
161 | S ^TMP($J ,"PRVL-MSG ",CNT)="" | |
162 | S XMTEXT= "^TMP($J," "PRVL-MSG" "," | |
163 | S XMDUZ=. 5 | |
164 | S XMY(DUZ )="" | |
165 | S XMY("
|
|
166 | S XMSUB=" PRVL CALC COMPLETED" D ^XMD | |
167 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.