Produced by Araxis Merge on 11/9/2018 12:34:04 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 | CHMLDRG.m | Mon Nov 5 16:41:33 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMLDRG.m | Mon Nov 5 17:50:06 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 324 |
Changed | 2 | 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 | CHMLDRG ;C VA/CR;DRG WEIGHTS LO AD;11/04/9 8 10:40 A M | |
2 | ;V1.0 | |
3 | ; PT #161 21 (Y2K), CPTS #1685 5 BY DTP ( 3-AUG-00) | |
4 | ; UPDATED TO FY07 W EIGHTS FIL E FORMAT - JEH 10/3 1/06 | |
5 | ; UPDATE TO FY15 DP T 9/15/14 | |
6 | ; DEV0165 54 DEV0128 93 EOF REP LACE DECNE T | |
7 | ;MTN02427 9 DPT 9/22 /15 FY16 L OAD ADD CH ECK FOR TY PE OF FILE | |
8 | ; dpt 4 /11/18 rem ove check for enviro nment | |
9 | ;S $ZTRAP ="^%ET" | |
10 | ; | |
11 | ENTER ; | |
12 | S TYPE="" | |
13 | S DIR(0)= "F",DIR("A ")="Enter FILE TYPE (D)ELIMITE D OR (N)OT DELIMITED : ",DIR("B ")="D" D ^ DIR K DIR ;MTN024279 DPT | |
14 | I Y'="D", "N" W !," TYPE MUST BE ""D"" O R ""N"" " G ENTER ;M TN024279 D PT | |
15 | I Y="","^ " G ENTER ;MTN024279 DPT | |
16 | S TYPE=Y ;MTN024279 DPT | |
17 | ;Y2K - Ch anged YR l ogic | |
18 | S YR=$E(D T,2,3) | |
19 | W !,"Ente r the year to use: " ,YR,"// " | |
20 | S YR=$E(D T,1,3) | |
21 | W !,"Ente r the year to use: " ,$$FMYR^CH TFLIB(YR), "// " | |
22 | R X:DTIME | |
23 | I X'="" W !,"Why ar e you not using this year's da te?" Q | |
24 | ; Y2K S C HBEGDT=2_Y R_1001,CHE NDT=2_YR_" 0930" | |
25 | S CHBEGDT =YR_1001,C HENDT=YR_" 0930" | |
26 | S CHRVDT= 9999999-CH BEGDT | |
27 | ;SET ENVI RONMENT | |
28 | S AYGSYS= XQVOL | |
29 | S AYGSYS= $S(AYGSYS= "ROU":"LIV E",AYGSYS= "XOU":"TRA IN",AYGSYS ="TOU":"TE ST",AYGSYS ="DOU":"DE V") | |
30 | S ENVIR=A YGSYS | |
31 | ;S DIR("B ")=ENVIR | |
32 | ;S DIR(0) ="SO^1:LIV E;2:TRAIN; 3:TEST;4:D EV" | |
33 | ;S DIR("L ",1)="Sele ct one of the follow ing enviro nments" | |
34 | ;S DIR("L ",2)="" | |
35 | ;S DIR("L ",3)=" 1 LIVE" | |
36 | ;S DIR("L ",4)=" 2 TRAIN" | |
37 | ;S DIR("L ",5)=" 3 TEST" | |
38 | ;S DIR("L ",6)=" 4 DEV" | |
39 | ;S DIR("L ",7)="" | |
40 | ;S DIR("L ")=" ^ QUIT" | |
41 | ;D ^DIR K DIR | |
42 | ;Q:$D(DUO UT) | |
43 | ;Q:Y="" | |
44 | ;Q:Y="^"! (Y="") | |
45 | ;S ENVIR= Y(0) | |
46 | S $ZE="", $ZT="END" | |
47 | ;SET DRG FILE NAME | |
48 | S DIR(0)= "F^3:50" | |
49 | S DIR("A" )="Enter D RG file na me (Weight .TXT)" D ^ DIR K DIR | |
50 | Q:$D(DUOU T) | |
51 | Q:Y="^"!( Y="") | |
52 | S CNAME=Y K DIR | |
53 | N FOLDER ,CNTR | |
54 | S IOF="#, *27,*91,*5 0,*74,*27, *91,*72" | |
55 | ;S FILE=C NAME,FOLDE R="" ;DEV0 16554 DPT | |
56 | X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1) ;DEV0 16554 DPT | |
57 | ;S FOLDER ="HAC_HFS$ :[SCR.TEMP _FILES]" ; DEV016554 DPT | |
58 | ;I UCI'=" HAC" S FOL DER="HAC_H FS$:[DSMMA NAG.CHAMPV A]" ;DEV01 6554 DPT | |
59 | ;S FILE=F OLDER_FILE | |
60 | ;S CHUCI= $S(UCI="DE V":"DEV",U CI="TST":" TEST",UCI= "TRN":"TRA IN",UCI="S LA":"LIVE" ,UCI="HAC" :"LIVE") ; DEV012893 DPT | |
61 | ;S FLDR=" /FS3BIG/CO DEUPDT/DRG UPDT/"_CHU CI | |
62 | ;D FTPFIL E^CHTFLIB9 (FILE," DNS fs3. DNS ",FLDR,"GE T") ;DEV012893 DPT | |
63 | ;H 5 ;DEV 012893 DPT | |
64 | ;S FILE=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .CODEUPDT. DRGUPDT."_ ENVIR_"]"_ CNAME ; NAME OF DRG FILE | |
65 | S FILE=" HAC_HFS$:[ DSMMANAG.C HAMPVA]"_C NAME ; DPT | |
66 | S POP=0 ,CNTR=0 ;D EV012893 D PT | |
67 | F S CNT R=CNTR+1 Q :(CNTR>5)! POP D ;D EV012893 D PT | |
68 | . X "D $SYSTEM.Pr ocess.SetZ EOF(1)" ; DEV016554 DPT | |
69 | . S POP =$$OPENFIR D^CHTFLIB9 (.FILE,"FI LE") ;DEV 012893 DPT | |
70 | .Q ;DEV0 12893 DPT | |
71 | I 'POP G END ;DEV01 2893 DPT | |
72 | MAIN ; | |
73 | ;O FILE: "R":5 | |
74 | M1 D RW ;W !!!,"RETU RNED HERE AFTER ERRO R IN RW LO OP.",X | |
75 | G M1 | |
76 | END | |
77 | D CLOSEF ^CHTFLIB9( FILE,"FILE ") ;DEV016 554 DPT | |
78 | X "D $SY STEM.Proce ss.SetZEOF (0)" ;DEV0 16554 DPT | |
79 | Q | |
80 | ; | |
81 | RW ;S $ZTR AP="ERR1" | |
82 | U FILE | |
83 | RW1 R X ;S X=$&ZLIB. %EBCASC(Y) | |
84 | G:$$STATU S^%ZISH EN D ;DEV0165 54 DPT | |
85 | I TYPE="N " D | |
86 | .S CHDRG= +$$LTRIM($ E(X,1,5)) I 'CHDRG G RW1 ; D RG NUMBER | |
87 | .S CHDESC =$$TRIM($E (X,24,99)) ; D ESCRIPTION | |
88 | .;CHECK H OW PADDED | |
89 | .S CHWT=+ $$LTRIM($E (X,100,110 )) ; T MA WEIGHT (4 decimal places) | |
90 | .S CHALOS =+$$LTRIM( $E(X,113,1 19)) ; A RITHMETIC MEAN LOS ( 1 decimal place) | |
91 | .S CHGLOS =+$$LTRIM( $E(X,120,1 31)) ; G EOMETRIC M EAN LOS | |
92 | .S CHSST= +$$LTRIM($ E(X,132,14 3)) ; S HORT STAY THRESHOLD | |
93 | I TYPE="D " D | |
94 | . S CHDR G=$P(X,"^" ,1) I 'CHD RG G RW1 ; DRG NUM BER MT N021760 DP T | |
95 | .S CHDESC =$P(X,"^", 4) ; DESCRIPTI ON MTN021 760 DPT | |
96 | .;CHECK HOW PADDED | |
97 | .S CHWT=$ P(X,"^",5) ; TMA WEIGHT (4 decimal pl aces) MTN 021760 DPT | |
98 | .S CHALOS =$P(X,"^", 6) ; ARI THMETIC ME AN LOS (1 decimal pl ace) MTN0 21760 DPT | |
99 | .S CHGLOS =$P(X,"^", 7) ; GEOM ETRIC MEAN LOS MTN0 21760 DPT | |
100 | .S CHSST= $P(X,"^",8 ) ; SHOR T STAY THR ESHOLD MT N021760 DP T | |
101 | ||
102 | S (CHLST, CHLSTC)="" ;JEH 9 /24/07 | |
103 | ;S CHLST= +$$LTRIM($ E(X,118,12 6)),CHLSTC =+$$LTRIM( $E(X,127,1 33)) ;J EH 9/24/07 - NOT USE D IN WEIGH T.TXT FILE | |
104 | I '$D(^CH MDIC(74100 2.16,"B",C HDRG)) D N EW G RW1 | |
105 | S PT=$O(^ CHMDIC(741 002.16,CHD RG,1,0)) G A1:'PT | |
106 | S $P(^CHM DIC(741002 .16,CHDRG, 1,PT,0),"^ ",8)=CHEND T | |
107 | A1 S ^CHMD IC(741002. 16,CHDRG,1 ,CHRVDT,0) =CHBEGDT_" ^"_CHDESC_ "^"_CHWT_" ^"_CHGLOS_ "^"_CHSST_ "^"_CHLST_ "^"_CHLSTC _"^^^"_CHA LOS | |
108 | S $P(^CHM DIC(741002 .16,CHDRG, 1,0),"^",3 )=CHRVDT,$ P(^(0),"^" ,4)=$P(^(0 ),"^",4)+1 | |
109 | S ^CHMDIC (741002.16 ,CHDRG,1," B",CHBEGDT ,CHRVDT)=" " | |
110 | G RW1 | |
111 | ; | |
112 | ;ERR1 U $ P | |
113 | ;I $ZE'[" DSM-E-ZCFA TAL" W !!, "UNEXPECTE D ERROR-ER R1",!,$ZE G END ;C F ILE ZQUIT | |
114 | RWEND | |
115 | Q | |
116 | NEW S $P(^ CHMDIC(741 002.16,0), "^",3)=CHD RG | |
117 | S $P(^CHM DIC(741002 .16,0),"^" ,4)=$P(^(0 ),"^",4)+1 | |
118 | S $P(^CHM DIC(741002 .16,CHDRG, 0),"^",1)= CHDRG,$P(^ (0),"^",2) =1,$P(^(0) ,"^",3)=1 | |
119 | S:'$D(^CH MDIC(74100 2.15,CHDRG ,1,0)) ^(0 )="^741002 .161D^CHRV DT^1" | |
120 | S ^CHMDIC (741002.16 ,CHDRG,1,C HRVDT,0)=C HBEGDT_"^" _CHDESC_"^ "_CHWT_"^" _CHGLOS_"^ "_CHSST_"^ "_CHLST_"^ "_CHLSTC_" ^^^"_CHALO S | |
121 | S ^CHMDIC (741002.16 ,"B",CHDRG ,CHDRG)="" | |
122 | S ^CHMDIC (741002.16 ,CHDRG,1," B",CHBEGDT ,CHRVDT)=" " | |
123 | Q | |
124 | ; | |
125 | LTRIM(TXT) ;TRIMS LE ADING SPAC ES FROM ST RING TXT | |
126 | N TTXT,N | |
127 | I '$D(TXT ) S TTXT=" " Q TTXT | |
128 | F N=1:1 Q :$E(TXT,N) '=" "!(N>$ L(TXT)) | |
129 | S TTXT=$E (TXT,N,$L( TXT)) | |
130 | Q TTXT | |
131 | ; | |
132 | TRIM(TXT) ;TRIMS TRA ILING SPAC ES FROM ST RING | |
133 | N N,TTXT | |
134 | I '$D(TXT ) S TTXT=" " Q TTXT | |
135 | F N=$L(TX T):-1 Q:$E (TXT,N,N)' =" "!(N<1) | |
136 | S TTXT=$E (TXT,1,N) | |
137 | Q TTXT | |
138 | ; | |
139 | ASENDT ;AS SIGN END D ATE TO DRG 'S NO LONG ER VALID F OR THE YEA R | |
140 | Q ;ADDED TO PREVEN T ACCIDENT AL SETTING OF END DA TES. DO TH E FOLLOWIN G TO RUN: D ASENDT+2 ^CHMLDRG | |
141 | S YR=$E(D T,1,3) | |
142 | W !,"Ente r the year to use: " ,$$FMYR^CH TFLIB(YR), "// " | |
143 | R X:DTIME | |
144 | I X'="" W !,"Why ar e you not using this year's da te?" Q | |
145 | ; Y2K S C HBEGDT=2_Y R_1001,CHE NDT=2_YR_" 0930" | |
146 | S CHBEGDT =YR_1001,C HENDT=YR_" 0930" | |
147 | S CHRVDT= 9999999-CH BEGDT | |
148 | S CTR=0 | |
149 | S BGDT=69 28998 ;SE TTING BEGI N DATE TO SEARCH (30 71001) | |
150 | S ENDT=30 80930 | |
151 | S I=0 F S I=$O(^CH MDIC(74100 2.16,I)) Q :'I D | |
152 | .I $D(^CH MDIC(74100 2.16,I,1,B GDT,0)) D | |
153 | ..I $P(^C HMDIC(7410 02.16,I,1, BGDT,0),"^ ",8)="" D | |
154 | ...S CTR= CTR+1 | |
155 | ...W !,I, ?4,$P(^CHM DIC(741002 .16,I,1,BG DT,0),"^", 2) | |
156 | ...S PT=$ O(^CHMDIC( 741002.16, I,1,0)) G B1:'PT | |
157 | ...S $P(^ CHMDIC(741 002.16,I,1 ,PT,0),"^" ,8)=CHENDT | |
158 | B1 ...; | |
159 | ...S ^CHM DIC(741002 .16,I,1,CH RVDT,0)=CH BEGDT_"^NO LONGER VA LID^0^0^0^ 0^0^^^0" | |
160 | ...S $P(^ CHMDIC(741 002.16,I,1 ,0),"^",3) =CHRVDT,$P (^(0),"^", 4)=$P(^(0) ,"^",4)+1 | |
161 | ...S ^CHM DIC(741002 .16,I,1,"B ",CHBEGDT, CHRVDT)="" | |
162 | ;G RW1 | |
163 | ; | |
164 | W !,"CTR = ",CTR |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.