Produced by Araxis Merge on 11/9/2018 12:33:49 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 | CHIVFI2.m | Mon Nov 5 16:41:01 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHIVFI2.m | Fri Nov 9 01:26:39 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 4 | 964 |
Changed | 3 | 6 |
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 | CHIVFI2 ;l g/yg/HARRI S;ICD-10 V ENDOR FILE INGEST | |
2 | ;;V1.0;Ja n 2012;HAR RIS TEAM | |
3 | ;;09/29/1 5 SBB DEF0 16554 fix for decnet | |
4 | ;; | |
5 | ;; This r outine rep laces the logic foun d in the H AC CHMLICD 2 routine | |
6 | ;; CHMLIC D2 ;JLR/DE N;ICD-9 CO DES TAPE R EAD IN;09/ 30/98 2:5 2 PM | |
7 | ;; and al so replace s the logi c in routi nes - CHML ICD3, CHML ICD4, and CHMLICD5 | |
8 | ;; CHMLIC D3 ;MCR/DE N;ICD-9 UP DATE CODES TO FILEMA N FORMAT;1 0/13/92 3 :28 PM | |
9 | ;; CHMLIC D4 ;MCR/DE N;UPDATE I CD-9 SERVI CE FILE;10 /15/98 4: 21 PM | |
10 | ;; CHMLIC D5 ;MCR/DE N;UPDATE I CD-9 DX FI LE;10/01/9 8 8:27 AM | |
11 | ;; | |
12 | Q | |
13 | ; | |
14 | AUTO(EFFDT ) ; | |
15 | D AUTO201 3(EFFDT) | |
16 | D AUTO201 4(EFFDT) | |
17 | W !!,"*** ********** ********** ********** ********** ********** ****" | |
18 | W !!," CO NGRATULATI ONS! THE H AC CHAMPVA ICD-10 AU TO-MAINTEN ANCE LOAD PROCESS CO MPLETED SU CCESSFULLY !" | |
19 | Q | |
20 | AUTO2013(E FFDT) ; | |
21 | S AUTO=1 | |
22 | W !!,"Beg inning Loa d of FY201 3 Mapping Tool files " H 1 | |
23 | K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y | |
24 | K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J | |
25 | S $ZE="" | |
26 | I $G(EFFD T)="" S EF FDT=313101 0 | |
27 | S X1=EFFD T,X2=-1 D C^%DTC | |
28 | S TERMDT= X | |
29 | ; | |
30 | K SFILES | |
31 | ;09/29/15 SBB DEF01 6554 fix f or decnet | |
32 | ;S IOBASE ="HACFS3"" DNS HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10UP DT.FY2013] " | |
33 | S IOBASE= "HAC_HFS$: [SCR.TEMP_ FILES.FS3B IG.CODEUPD T.ICD10UPD T.FY2013]" | |
34 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
35 | ;S EDT="1 0/1/2014" D READ1 | |
36 | S IO=IOBA SE_"ICD10C M_APPVD_03 _24_2014_1 2_41_14.CS V" | |
37 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
38 | S DATA("R T")="D" | |
39 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
40 | ; | |
41 | ; PCS | |
42 | ; | |
43 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
44 | S IO=IOBA SE_"ICD10P CS_APPVD_0 3_24_2014_ 12_42_13.C SV" | |
45 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
46 | S DATA("R T")="P" | |
47 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
48 | Q | |
49 | AUTO2014(E FFDT) ; | |
50 | S AUTO=1 | |
51 | W #,"Begi nning Load of FY2014 Mapping T ool files" H 1 | |
52 | S AUTO=1 | |
53 | K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y | |
54 | K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J | |
55 | S $ZE="" | |
56 | I $G(EFFD T)="" S EF FDT=314101 0 | |
57 | S X1=EFFD T,X2=-1 D C^%DTC | |
58 | S TERMDT= X | |
59 | ; | |
60 | K SFILES | |
61 | ;09/29/15 SBB DEF01 6554 fix f or decnet | |
62 | ;S IOBASE ="HACFS3"" DNS HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10UP DT.FY2014] " | |
63 | S IOBASE= "HAC_HFS$: [SCR.TEMP_ FILES.FS3B IG.CODEUPD T.ICD10UPD T.FY2014]" | |
64 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
65 | ;S EDT="1 0/1/2014" D READ1 | |
66 | S IO=IOBA SE_"ICD10C M_APPVD_AU G2013_07_0 8_2014_08_ 36_21.csv" | |
67 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
68 | S DATA("R T")="D" | |
69 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
70 | ; | |
71 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
72 | S IO=IOBA SE_"ICD10C M_APPVD_JA N2014_07_2 3_2014_13_ 07_11.csv" | |
73 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
74 | S DATA("R T")="D" | |
75 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
76 | ; | |
77 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
78 | S IO=IOBA SE_"ICD10C M_APPVD_MA R2014_07_2 8_2014_12_ 10_35.csv" | |
79 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
80 | S DATA("R T")="D" | |
81 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
82 | ; | |
83 | ; PCS | |
84 | ; | |
85 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
86 | S IO=IOBA SE_"ICD10P CS_APPVD_A UG2013_07_ 08_2014_08 _36_49.csv " | |
87 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
88 | S DATA("R T")="P" | |
89 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
90 | ; | |
91 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
92 | S IO=IOBA SE_"ICD10P CS_APPVD_J AN2014_07_ 23_2014_13 _08_11.csv " | |
93 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
94 | S DATA("R T")="P" | |
95 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
96 | ; | |
97 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
98 | S IO=IOBA SE_"ICD10P CS_APPVD_M AR2014_07_ 28_2014_12 _05_48.csv " | |
99 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
100 | S DATA("R T")="P" | |
101 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
102 | Q | |
103 | ; | |
104 | EN ; entry point for ingesting data file (s) | |
105 | ; | |
106 | K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y | |
107 | K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J | |
108 | S $ZE="" | |
109 | ;S $ZT="E OF^CHIVFI2 " ; necess ary error trapping l ogic for p rocess to complete | |
110 | ; Modules called: | |
111 | ; INIT = initialize variables | |
112 | ; HDR = prints pro cess page header | |
113 | ; READ = gets file type and f ile data I O string. Also gets Vendor nam e if a (B) ase file l oad | |
114 | ; OPEN = opens the file retur ned in the IO string from the READ modul e | |
115 | ; LOAD = loads file data into a tempora ry global for proces sing. The temporary global is defined in the INIT module | |
116 | ; | |
117 | D INIT,HD R,READ,HDR :'STOP,OPE N:'STOP,LO AD:'STOP | |
118 | ; | |
119 | EN1 ; cont inue proce ssing -lg | |
120 | ; when th e '<END OF FILE>' er ror occurs during th e data fil e load, pr ocessing c omes to, a nd continu es here | |
121 | ; after b eing trapp ed @EOF su broutine. If an erro r other th an 'end of file' occ urs the er ror will b e posted | |
122 | ; to the screen and processin g will com e to a sto p and retu rn the use r to the m enu option . | |
123 | ; call to parse dat a for inst allation t o Diagnosi s file (#7 41006.05) and Servic es file (# 741006) | |
124 | ; Modules called: | |
125 | ; PARSE = module i n this rou tine calle d to proce ss (B)ase type data files for baseline a nd mainten ance code set load | |
126 | ; PARSEM = module i n this rou tine calle d to proce ss (M)appi ng type da ta files | |
127 | ; | |
128 | D:'STOP P ARSEM | |
129 | I 'STOP D ; print process st atistics i f processi ng complet e | |
130 | .S DATA(" CTM")=$$NO W^CHIUTIL( ) | |
131 | .W !," T he "_$S(DA TA("LDTYP" )="B":"ICD -10",1:"") _" load pr ocess is C omplete!", ?38," : ", DATA("CTM" ) | |
132 | .W !!,$E( LN,1,41),! | |
133 | .; put lo ad statist ics here * * | |
134 | .W !," Pro cessing St arted : ", DATA("STTM ") | |
135 | .W !," FileM an Load St arted : ", DATA("FMTM ") | |
136 | .W !," Proce ssing Comp leted : ", DATA("CTM" ) | |
137 | .W !!," Total ICD Diagnosis Codes : " ,$J(DATA(" DXCNT"),7) | |
138 | .W !," Total ICD Procedure Codes : ", $J(DATA("P CSCNT"),7) | |
139 | .W !," Total Codes : ", $J(DATA("D XCNT")+DAT A("PCSCNT" ),7) | |
140 | .I 'MMODE ,$G(DATA(" D")) D | |
141 | ..W !," Total D Status R ecords : " ,$J(DATA(" D"),7) | |
142 | ..W !," Subtotal Added to F ile(s) : " ,$J((DATA( "DXCNT")+D ATA("PCSCN T"))-DATA( "D"),7) | |
143 | ..Q | |
144 | .Q | |
145 | W !!,$E(L N,1,41),! | |
146 | R:$G(AUTO )'=1 !!," Press <E nter> to c ontinue ", *X | |
147 | ; if in m aitenance mode print the recor d status' | |
148 | I 'STOP,$ G(DATA("LD TYP"))="M" ,MMODE W @ IOF,$E(LN, 1,41),!! D Q | |
149 | .F X="N", "C","D","R ","U" W !, $S(X="N":" New",X="C" :"Changed" ,X="D":"De leted",X=" R":"Reinst ated",1:"U nofficial Change") D | |
150 | ..W !," Total ",X ," Records : ",$J(+$ G(DATA(X)) ,7) | |
151 | ..Q | |
152 | .W !!,$E( LN,1,41),! | |
153 | .R:$G(AUT O)'=1 !!," Press < Enter> to continue " ,*X | |
154 | .Q | |
155 | ; | |
156 | K @GLOBAL ; kill d ata in tem porary sto rage globa l | |
157 | Q | |
158 | INIT ; iti alize some required variables | |
159 | ; | |
160 | N MM,DD | |
161 | S U="^",D UZ=1,DUZ(0 )="@" ; *** FOR TESTING * ** -lg | |
162 | I '$D(IOF ) S IOF="# ,$C(27,91, 50,74,27,9 1,72)" ; if the pagefeed v ariable is undefined , define i t -lg | |
163 | ; | |
164 | S GLOBAL= "^UTILITY( $J,""ICD"" )" K @GLOB AL ; tempora ry data st orage glob al | |
165 | S STOP=0, $P(LN,"_", 80)="" ; process ing STOP f lag, line characters | |
166 | S (DATA(" DXCNT"),DA TA("PCSCNT "))=0 ; Diagnos is and Pro cedure rec ord counte rs | |
167 | S MMODE=1 ; MMODE = maintenan ce mode | |
168 | S DATA("D ATE")=$P($ $FMDT^CHIU TIL(),".") ; today's date | |
169 | ; set eff ective yea r - effect ive and te rmination dates alwa ys 10/01 a nd 09/30 r espectivel y | |
170 | ; if mont h is Oct ( 10), Nov ( 11), or De c (12), ef fective an d terminat ion dates are this y ear, other wise previ ous year | |
171 | S DATA("Y R")=$E(DAT A("DATE"), 1,3)-(($E( DATA("DATE "),4,5))'> 9) ; effec tive year | |
172 | S DATA("E FFDATE")=D ATA("YR")_ "1001" ; effecti ve date always Oct 1st | |
173 | S DATA("T ERMDATE")= DATA("YR") _"0930" ; termina tion date always Sep 30th | |
174 | Q | |
175 | OPEN ; OPE N vendor d ata file | |
176 | ; | |
177 | W !!," S tarting... " ; messag e to indic ate ingest process i s starting | |
178 | O IO:"R": 10 ; open load file with a 10 second tim eout | |
179 | ; if unab le to open the file notify the user and set the 'S TOP' flag to stop al l further processing | |
180 | I '$T D S STOP=1 Q | |
181 | .W !!,"Un able to op en "_DATA( "FILE"),!! ,"Please m ake sure t he file na me is corr ect.",!! | |
182 | Q | |
183 | READ ; pro mpt user t o select d ata file f or ingest | |
184 | ; | |
185 | ;K IN S I N=0,IN("DI R")="HACFS 3"" DNS HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10MA PPINGTOOL. MAINT]" | |
186 | ;S IN("FI LES")="*.C SV" | |
187 | K IN S IN ="M" | |
188 | S IO=$$ME NU^CHICDOL (.IN,.SEL, 1) I IO="" S STOP=1 Q | |
189 | S SEL("FI LETYPE")=" M" | |
190 | ; get dat a filename and data file type: either (B )ase or (M )apping | |
191 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
192 | ; get rec ord type i n data fil e: either Diagnosis or Procedu re code re cords | |
193 | S DATA("R T")=$S(SEL ("CODETYPE ")="C":"D" ,1:"P") | |
194 | ; change the date l ogic from what origi nal was do ing to fil ename date forwarded to next F Y border | |
195 | S EDT=$G( SEL("WNAME ")) Q:EDT= "" | |
196 | S EDT=$S( EDT["MAINT ":$P(EDT," MAINT",2), EDT["aint" :$P(EDT,"a int",2),$D (SEL("FY") ):"__"_$E( SEL("FY"), 3,9),1:"") | |
197 | S EDT=$P( EDT,"_",1, 3),EDT=$P( EDT," "),E DT=$TR(EDT ,"_","/") | |
198 | S:$P(EDT, "/",3)?2N $P(EDT,"/" ,3)="20"_$ P(EDT,"/", 3) | |
199 | ;S EDT=$P (EDT,"_",3 )-1700_$P( EDT,"_")_$ P(EDT,"_", 2) | |
200 | ;S DATA(" DATE")=EDT | |
201 | ;S DATA(" YR")=$E(DA TA("DATE") ,1,3)-(($E (DATA("DAT E"),4,5))' >9)+1 ; ef fective ye ar | |
202 | S OK=0 | |
203 | READ1 ; | |
204 | F D Q:O K'=0 | |
205 | . S %DT(" A")="Pleas e enter th e Effectiv e Date for this load : " | |
206 | . S %DT(" B")="10/01 /"_($P(EDT ,"/",3)+1) | |
207 | . ;E S % DT("B")=ED T | |
208 | . S %DT=" AE" | |
209 | . I '$D(D T) D NOW^% DTC S DT=X | |
210 | . ;S %DT( 0)=DT | |
211 | . D ^%DT | |
212 | . I X="^" S OK=-1,S TOP=1 Q | |
213 | . I Y<DT W !!,"Plea se select a date tha t is not i n the past .",! Q | |
214 | . ;I Y<ED T W !,"You can't pic k the date before th e spreadsh eet date" Q | |
215 | . S EFFDT =Y | |
216 | . W !,"Th e Effectiv e Date for this main tenance lo ad will be : " D DD^% DT W Y | |
217 | . S DATA( "EFFDATE") =EFFDT | |
218 | . S X1=EF FDT,X2=-1 D C^%DTC | |
219 | . S DATA( "TERMDATE" )=X | |
220 | . W !,"Ar e you sure : " S %=1 D YN^DICN | |
221 | . I %=-1 S OK=-1,ST OP=1 Q | |
222 | . I %=1 S OK=1 | |
223 | I OK=-1 Q | |
224 | ;S DATA(" EFFDATE")= DATA("YR") _"1001" ; effect ive date always Oc t 1st | |
225 | ;S DATA(" TERMDATE") =DATA("YR" )_"0930" ; termin ation date always Se p 30th | |
226 | Q | |
227 | HDR ; do a pagefeed and then p rint the p rocess hea der to the screen | |
228 | ; | |
229 | W @IOF,!, " THE HAC CHAMPVA I CD-10 MAIN TENANCE LO AD PROCESS ",!,$E(LN, 1,51),! | |
230 | Q | |
231 | ; | |
232 | LOAD ; loa d the data file | |
233 | ; | |
234 | S DATA("S TTM")=$$NO W^CHIUTIL( ) ; start time | |
235 | W !!," . .. *Proces sing Mappi ng Tool Up date* ..." | |
236 | W !!," P rocessing data file. .. ",D ATA("FILE" ),!!?20,"P rocessing Started : ",DATA("ST TM") | |
237 | W !!," . .. Please be patient ",!," ... wait for processing to comple te",!! | |
238 | S A=$ZUTI L(68,40,1) K @GLOBAL | |
239 | U IO F Y= 1:1 R X Q: $ZEOF=-1 Q:X="" S @GLOBAL@(Y )=X | |
240 | C IO | |
241 | Q | |
242 | ; | |
243 | ; | |
244 | PARSEM ; p arse AI ma pping data for add t o DX and P CS file | |
245 | ; | |
246 | U 0 S $ZT ="" | |
247 | S DATA("F MTM")=$$NO W^CHIUTIL( ) ; FileMa n load sta rt time | |
248 | W !?18,"F ileMan Loa d Started : ",DATA(" FMTM") | |
249 | W !!," . .. Parsing the mappi ng tool fi le",! | |
250 | ; set up DATA array with Optu m vendor d ata (start Y=2 to by pass heade rs) | |
251 | F BY=2:1 S SL=$G(@G LOBAL@(BY) ) Q:SL="" D PARSEM1 | |
252 | Q | |
253 | PARSEM1 ; | |
254 | ; | |
255 | ; *** nex t line nec essary at this point to format mapping t ool files *** Glaz d eveloped f unction ca ll -lg 3/8 /12 | |
256 | S SL=$S(D ATA("RT")= "D":$$MTFI XCM^CHICDO L(SL),1:$$ MTFIXPCS^C HICDOL(SL) ) ; *** f unction to realign s preadsheet colums ** * -lg 3/8/ 12 | |
257 | ; | |
258 | S DATA("C ODE")=$TR( $P(SL,U)," x","X") ; ICD code | |
259 | S DATA("N AME")=$P(S L,U,2) ; Code Name | |
260 | S DATA("C VA")=+$P(S L,U,5) ; ChampVA AI test valu e - C VA is ien #1 in file #741002.9 4 | |
261 | S DATA("S B")=+$P(SL ,U,6) ; Spina Bifi da AI test value - S B is ien #6 in file #741002.9 4 | |
262 | ; next tw o lines ar e to chang e CVA and SB value f rom extern al to inte rnal IEN f ormat | |
263 | S DATA("C VA")=$O(^D IC(741100, "B","TEST #"_DATA("C VA"),"")) | |
264 | S DATA("S B")=$O(^DI C(741100," B","TEST # "_DATA("SB "),"")) | |
265 | S DATA("D UZ")=$P(SL ,U,12) ; DUZ of use r approvin g AI test mapping | |
266 | S DATA("D T")=$P(SL, U,13) ; date user approved A I test map ping | |
267 | S DATA("S TATUS")=$P (SL,U,14) ; Optum status | |
268 | ; If it i s incomple te, don't stamp 0, d elete the data with "@". File man is def ined as | |
269 | ; set of codes 1:SU BDIVIDED C ODE; so 0 is not val id value. | |
270 | S DATA("S UBDIV")=$S ($P(SL,U,1 5)="I":1,1 :"@") ; Optum Comp lete | |
271 | ; | |
272 | S IEN=+$$ GETIEN^CHI VFI($S(DAT A("RT")'=" D":$TR(DAT A("CODE"), "."),1:DAT A("CODE")) ,DATA("RT" )) ; modul e to match the code in the map ping file with the I EN in the live file | |
273 | ;I 'IEN S @GLOBAL@( "NO IEN FO UND",DATA( "CODE"))=" " Q ; qui t if IEN n ot found * ** do we w ant to sto re if we d on't find and IEN? * ** -lg 2/1 7/12 | |
274 | ; next fe w cases ch eck 'Statu s' of reco rd | |
275 | ; N = NEW | |
276 | ; C = CHA NGE | |
277 | ; D = DEL ETED | |
278 | ; R = REI NSTATED | |
279 | ; U = UNO FFICIAL CH ANGE | |
280 | ;;W !,DAT A("STATUS" )," / ",$G (IEN)," / ",SL | |
281 | S I=$I(DA TA(DATA("S TATUS"))) | |
282 | I DATA("S TATUS")="D " D DEACT ; set te rmination date | |
283 | I DATA("S TATUS")="R " D REACT ; see RE ACT module | |
284 | I DATA("S TATUS")="C "!(DATA("S TATUS")="U ") D CHANG E(IEN) | |
285 | I DATA("S TATUS")="N " D ADD ; populate appropriat e file | |
286 | ; count c ode types for stats | |
287 | S @$S(DAT A("RT")="D ":"DATA("" DXCNT"")=D ATA(""DXCN T"")+1",1: "DATA(""PC SCNT"")=DA TA(""PCSCN T"")+1") | |
288 | I $X>0 W !,BY," ",S L,! | |
289 | Q | |
290 | ; | |
291 | DEACT ; co de deactiv ation | |
292 | ; Nothing to deacti vate | |
293 | I 'IEN Q | |
294 | ; Set DX terminatio n date | |
295 | I DATA("R T")="D" D | |
296 | . Q:'$D(^ CHMICDX(IE N,0)) | |
297 | . S:$P(^C HMICDX(IEN ,0),U,23)= "" $P(^CHM ICDX(IEN,0 ),U,23)=DA TA("TERMDA TE") | |
298 | . ;S Y=$O (^CHMICDX( IEN,103,0) ) Q:'Y | |
299 | . ;S:$P(^ CHMICDX(IE N,103,Y,0) ,U,2)="" $ P(^CHMICDX (IEN,103,Y ,0),U,2)=D ATA("TERMD ATE") | |
300 | . Q | |
301 | ; PCS is defined wi th the mos t recent h istory ent ry being a ctive | |
302 | I DATA("R T")="P" D | |
303 | . S Y=$O( ^CHMSERV(I EN,1,0)) Q :'Y | |
304 | . Q:$P($G (^CHMSERV( IEN,1,Y,0) ),U)'="" ; If alread y terminat ed, we are done | |
305 | . S $P(^C HMSERV(IEN ,1,Y,0),U) =DATA("TER MDATE") ; not settin g B xref s ince uncov entional u se multipl e | |
306 | . Q | |
307 | Q | |
308 | REACT ; co de mainten ace reacti vation (R: reinstated ) | |
309 | ; *** the re could b e addition al changes when rein stating a code ? cal l CHANGE m odule just in case * ** -lg 3/1 5/12 | |
310 | I DATA("R T")="D" D Q | |
311 | . I 'IEN D DXI Q ; add ICD c ode if ICD code not found in f ile | |
312 | . ; clear terminati on date | |
313 | . D CHANG E(IEN) ; c all CHANGE to create history a nd save da ta | |
314 | . ; clear terminati on date | |
315 | . S $P(^C HMICDX(IEN ,0),U,23)= "" | |
316 | . Q | |
317 | I DATA("R T")="P" D Q | |
318 | . I 'IEN D PCSI Q ; add ICD code if IC D code not found in file | |
319 | . ; *** 3 /15/12 cal l to CHANG E implemen ted in cas e addition l changes during rei nstate nex t line not needed? * ** -lg | |
320 | . ;I $D(^ CHMSERV(IE N,0)) S Y= $O(^CHMSER V(IEN,1,0) ) I Y,$P($ G(^CHMSERV (IEN,1,Y,0 )),U) S $P (^CHMSERV( IEN,1,Y,0) ,U)="" | |
321 | . D CHANG E(IEN) ; c all CHANGE just in c ase there are additi onal chang es beside just reins tating the code | |
322 | Q | |
323 | CHANGE(DA) ; for cod es with a status of C:change U :unofficia l change R :reinstate d | |
324 | ; | |
325 | S DIE=$S( DATA("RT") ="D":"^CHM ICDX(",1:" ^CHMSERV(" ) | |
326 | I +$G(IEN )=0 G ADD | |
327 | D DXIC:DA TA("RT")=" D",PCSIC:D ATA("RT")= "P" | |
328 | Q | |
329 | ; | |
330 | ADD | |
331 | I IEN D Q | |
332 | . ; There is record already f or some re ason | |
333 | . K DA S DA=IEN D D XIC:DATA(" RT")="D",P CSIC:DATA( "RT")="P" | |
334 | D DXI:DAT A("RT")="D ",PCSI:DAT A("RT")="P " | |
335 | Q | |
336 | ; mapping file inge st FileMan call to p opulate AI test Prog ram Indica tor multip le | |
337 | ;S DA=IEN ,DIE=$S(DA TA("RT")=" D":"^CHMIC DX(",1:"^C HMSERV(") | |
338 | ;F CT="CV A","SB" D | |
339 | ;. S DATA (.01)=$S(C T="CVA":1, 1:6),DATA( .02)=DATA( CT),DATA(. 03)=DATA(" DUZ") | |
340 | ;. S DATA (.04)=DATA ("DT") | |
341 | ;. I DATA ("RT")="D" D | |
342 | ;. . S DR ="102///^S X=DATA(.0 1)" ; this is the Pr ogram Indi cator mult iple that holds AI t est inform ation for various pr ograms (fr om mapping data) | |
343 | ;. . S DR (2,741006. 05102)=".0 1////^S X= DATA(.01); .02////^S X=DATA(.02 );.03////^ S X=DATA(. 03);.04/// /^S X=DATA (.04)" | |
344 | ;. I DATA ("RT")="P" D | |
345 | ;. . S DR ="102////^ S X=DATA(. 01)" ; thi s is the P rogram Ind icator mul tiple that holds AI test infor mation for various p rograms (f rom mappin g data) | |
346 | ;. . S DR (2,741006. 0102)=".01 ////^S X=D ATA(.01);. 02////^S X =DATA(.02) ;.03////^S X=DATA(.0 3);.04//// ^S X=DATA( .04)" | |
347 | ;. S DIC= DIE,DIC(0) ="L" D ^DI E | |
348 | Q | |
349 | DXI ; make FileMan c all to pop ulate CHAM PVA ICD DI AGNOSIS fi le (#74100 6.05) | |
350 | ; create a new reco rd | |
351 | F S DA=$ P(^CHMICDX (0),U,3)+1 I '$D(^CH MICDX(DA)) S $P(^CHM ICDX(0),U, 3)=DA,IEN= DA Q | |
352 | S $P(^CHM ICDX(0),U, 4)=$P(^CHM ICDX(0),U, 4)+1 | |
353 | DXIC ; mid -entry poi nt to make changes t o existing DX codes | |
354 | ; SET Fil eMan DR va riable (fi eld edit s tring) | |
355 | S DIE="^C HMICDX(",D IC=DIE | |
356 | ; create history fo r old entr y | |
357 | I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D | |
358 | . N DINUM ,SUB,DABK | |
359 | . S DABK= DA | |
360 | . ; using DINUM via FileMan t o set the END DATE m ultiple fi eld (#1) t hen settin g .01 fiel d (END DAT E) NULL in module PC SI | |
361 | . S OED=$ P(^CHMICDX (DA,0),U,2 2),ONAME=$ P(^CHMICDX (DA,0),U), OTERM=$P(^ CHMICDX(DA ,0),U,23), OSUBDIV=$P (^CHMICDX( DA,0),U,16 ) | |
362 | . S:DATA( "STATUS")' ="R" OTERM =DATA("TER MDATE") | |
363 | . S (DINU M,SUB)=(99 99999-OED) | |
364 | . K DR S DR="103/// ^S X=OED" | |
365 | . I $D(^C HMICDX(DA, 103,DINUM, 0)) K ^CHM ICDX(DA,10 3,"B",+^CH MICDX(DA,1 03,DINUM,0 )),^CHMICD X(DA,103,D INUM,0) | |
366 | . S DR(2, 741006.051 03)=".01// /^S X=OED; .02///^S X =OTERM;.03 ///^S X=ON AME;.04/// ^S X=OSUBD IV" | |
367 | . S DIC=D IE,DIC(0)= "L" D ^DIE | |
368 | . K DA S DA=DABK | |
369 | S DATA("C AT")=$L($T R(DATA("NA ME"),".")) ,DATA("CAT ")=$S(DATA ("CAT")=3: 1,DATA("CA T")=4:2,DA TA("CAT")= 5:3,1:4) ; define cat egory fiel d#3 ;ICD-1 0 RCS Bug 36 | |
370 | K DR S DR =".01////^ S X=DATA(" "NAME"");1 ///^S X=DA TA(""CODE" ");2////D" | |
371 | S DR=DR_" ;3////^S X =DATA(""CA T"");15/// ^S X=DATA( ""SUBDIV"" );24////1" | |
372 | S DR=DR_" ;22///^S X =DATA(""EF FDATE"")" | |
373 | S DIC=DIE ,DIC(0)="L " D ^DIE I $X>0 S GL AZBR=1 | |
374 | D MFI | |
375 | Q | |
376 | PCSI ; mak e FileMan call to po pulate CHA MPVA SERVI CES file ( #741006) | |
377 | K DA F S DA=$P(^CH MSERV(0),U ,3)+1 I '$ D(^CHMSERV (DA)) S $P (^CHMSERV( 0),U,3)=DA ,IEN=DA Q | |
378 | S $P(^CHM SERV(0),U, 4)=$P(^CHM SERV(0),U, 4)+1 | |
379 | PCSIC ; mi d-entry po int to mak e changes to existin g PCS code s | |
380 | S DIE="^C HMSERV(",D IC=DIE | |
381 | S OLDR=$G (^CHMSERV( DA,0)) | |
382 | S DATA("O SUBDIV")=$ P(OLDR,U,9 ) | |
383 | I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D | |
384 | . ; termi nate curre nt PCS cod e descript ion before applying change *** -lg 3/7/1 2 | |
385 | . ; for P CS change must first terminate existing descriptio n *** -lg 3/7/12 | |
386 | . ; if th e current effective date is sa me as the last effec tive date clear the node to ad d the desc ription ch ange | |
387 | . S Y=$O( ^CHMSERV(D A,1,0)) I Y D Q | |
388 | . . I Y=( 9999999-DA TA("EFFDAT E")) K ^CH MSERV(DA,1 ,Y) Q | |
389 | . . I $D( ^CHMSERV(D A,1,Y,0)), '$P(^CHMSE RV(DA,1,Y, 0),U) S $P (^(0),U)=D ATA("TERMD ATE"),$P(^ (0),U,10)= DATA("OSUB DIV") | |
390 | ; update main recor d | |
391 | K DR S DR =".01///"_ $TR(DATA(" CODE"),"." )_";.05/// ^S X=""ICD -10"";.09/ //^S X=DAT A(""SUBDIV "")" | |
392 | S DIC=DIE ,DIC(0)="L " D ^DIE | |
393 | ; update the | |
394 | N DINUM,S UB | |
395 | S (DINUM, SUB)=(9999 999-DATA(" EFFDATE")) ; DI NUM to set uncoventi onal 'END DATE' mult iple struc ture | |
396 | ; using D INUM via F ileMan to set the EN D DATE mul tiple fiel d (#1) the n setting .01 field (END DATE) NULL in m odule PCSI | |
397 | K DR S DR ="1///^S X =DATA(""EF FDATE"")" | |
398 | S DR(2,74 1006.01)=" .01///^S X =DATA(""EF FDATE"");. 09///^S X= DATA(""EFF DATE"");30 .01///^S X =DATA(""NA ME"");.1// /^S X=DATA (""SUBDIV" ")" | |
399 | ; if it i s already there, kil l it, we a re setting it again | |
400 | K ^CHMSER V(DA,1,DIN UM) | |
401 | S DIC=DIE ,DIC(0)="L " D ^DIE | |
402 | S $P(^CHM SERV(DA(1) ,1,SUB,0), U)="" ; se t uncovent ional 'END DATE' mul tiple .01 field equa l to "" | |
403 | K ^CHMSER V(DA(1),1, "B",DATA(" EFFDATE"), SUB) ; no w kill the B-xref on the uncov entional s etting of the 'END D ATE' .01 f ield | |
404 | D MFI | |
405 | Q | |
406 | MFI ; | |
407 | ; mapping file inge st FileMan call to p opulate AI test Prog ram Indica tor multip le | |
408 | N DA,DR,I ,X,Y ; new DA,DR to get pertin ent DA,DR for DIAGNO SIS entrie s without affecting data for V endor Data file #741 033 | |
409 | K DA S DA =IEN,DIE=$ S(DATA("RT ")="D":"^C HMICDX(",1 :"^CHMSERV (") | |
410 | S TG=$E(D IE,1,*-1) | |
411 | ;F PI="CV A","SB" D | |
412 | . ;S DATA ("PI")=$S( PI="CVA":1 ,1:6),DATA ("AI")=DAT A(PI),DA(1 )=DATA("PI ") | |
413 | . ;K DR S DR="102// /^S X=DATA (""PI"")" ; this is the Progra m Indicato r multiple that hold s AI test informatio n for vari ous progra ms (from m apping dat a) | |
414 | . ;S DR(2 ,$S(DATA(" RT")="D":7 41006.0510 2,1:741006 .0102))=". 01////^S X =DATA(""PI "");.02/// /^S X=DATA (""AI"");. 03////^S X =DATA(""DU Z"");.04// //^S X=DAT A(""DT"")" | |
415 | . ;S DIC= DIE,DIC(0) ="L" D ^DI E | |
416 | I DATA("C VA")'="" D | |
417 | . I $D(@T G@(IEN,102 ,1,0)) | |
418 | . . S HN= $O(@TG@(IE N,102,1,10 1,"A"),-1) +1 | |
419 | . . I DAT A("CVA")=$ P(@TG@(IEN ,102,1,0), "^",2) Q | |
420 | . . S @TG @(IEN,102, 1,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN | |
421 | . . S @TG @(IEN,102, 1,101,HN,0 )=@TG@(IEN ,102,1,0) | |
422 | . . S @TG @(IEN,102, 1,101,"B", 1,HN)="" | |
423 | . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT") | |
424 | . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,1 ,0)),"^",3 ) | |
425 | . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,1,0 )),"^",4) | |
426 | . S @TG@( IEN,102,1, 0)="1^"_DA TA("CVA")_ "^"_DDUZ_" ^"_DDT | |
427 | . S @TG@( IEN,102,"B ",1,1)="" | |
428 | I DATA("S B")'="" D | |
429 | . I $D(@T G@(IEN,102 ,6,0)) | |
430 | . . S HN= $O(@TG@(IE N,102,6,10 1,"A"),-1) +1 | |
431 | . . I DAT A("SB")=$P (@TG@(IEN, 102,6,0)," ^",2) Q | |
432 | . . S @TG @(IEN,102, 6,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN | |
433 | . . S @TG @(IEN,102, 6,101,HN,0 )=@TG@(IEN ,102,6,0) | |
434 | . . S @TG @(IEN,102, 6,101,"B", 1,HN)="" | |
435 | . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT") | |
436 | . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,6 ,0)),"^",3 ) | |
437 | . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,6,0 )),"^",4) | |
438 | . S @TG@( IEN,102,6, 0)="6^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT | |
439 | . S @TG@( IEN,102,"B ",6,6)="" | |
440 | I DATA("S B")'="" D | |
441 | . I $D(@T G@(IEN,102 ,7,0)) | |
442 | . . S HN= $O(@TG@(IE N,102,7,10 1,"A"),-1) +1 | |
443 | . . I DAT A("SB")=$P (@TG@(IEN, 102,7,0)," ^",2) Q | |
444 | . . S @TG @(IEN,102, 7,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN | |
445 | . . S @TG @(IEN,102, 7,101,HN,0 )=@TG@(IEN ,102,7,0) | |
446 | . . S @TG @(IEN,102, 7,101,"B", 1,HN)="" | |
447 | . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT") | |
448 | . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,7 ,0)),"^",3 ) | |
449 | . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,7,0 )),"^",4) | |
450 | . S @TG@( IEN,102,7, 0)="7^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT | |
451 | . S @TG@( IEN,102,"B ",7,7)="" | |
452 | I DATA("C VA")+DATA( "SB") D | |
453 | . S X=0 F I=0:1 S X =$O(@TG@(I EN,102,X)) Q:'X | |
454 | . S @TG@( IEN,102,0) ="^741006. 0"_$S(DATA ("RT")="D" :5102,1:10 2)_"^"_$O( @TG@(IEN,1 02,"A"),-1 )_"^"_I | |
455 | Q | |
456 | ; | |
457 | EOF ; come here on e nd of file error; OR ANY OTHER error -lg | |
458 | ; | |
459 | S ER=$ZE | |
460 | I IO'="" C IO U 0 | |
461 | I ER["<EN DOFFILE>" D G EN1 ; continue on with l oad @EN1 | |
462 | .W !," . .. End of File reach ed ...",!! ," ... St arting Fil eMan file load ... " ,! | |
463 | .S DATA(" FMTM")=$$N OW^CHIUTIL () ; FileM an load st art time | |
464 | .W !?18," FileMan Lo ad Started : ",DATA( "FMTM") | |
465 | .Q | |
466 | I ER'="" W !!," *** A System error has occurred! ***",!!?4, ER,!! | |
467 | W $E(LN,1 ,39),! | |
468 | R !!," Press <Ent er> to con tinue ",*X | |
469 | Q | |
470 | TERMINATE ; | |
471 | F R !,CO DE D | |
472 | . S IEN=0 | |
473 | . I CODE? 1"S42".E D Q | |
474 | . . S IEN =$$GETIEN^ CHIVFI(COD E,"D") | |
475 | . . I IEN ,$D(^CHMIC DX(IEN,0)) ,'$P(^CHMI CDX(IEN,0) ,U,23) S $ P(^CHMICDX (IEN,0),U, 23)=311093 0 W " ",IE N," done" Q | |
476 | . I CODE' ["-" D Q | |
477 | . . S IEN =$$GETIEN^ CHIVFI(COD E,"P") W ! ,"*",CODE, " ",IEN | |
478 | . . I IEN S Y=$O(^C HMSERV(IEN ,1,0)) I Y '="",'$P($ G(^CHMSERV (IEN,1,Y,0 )),U) S $P (^CHMSERV( IEN,1,Y,0) ,U)=311093 0 W " done ",! ZW ^CH MSERV(IEN, 1) W ! Q | |
479 | . S CODE= $TR(CODE," "),SCODE= $P(CODE,"- ") | |
480 | . F D Q :SCODE>$P( CODE,"-",2 ) | |
481 | . . S IEN =$$GETIEN^ CHIVFI(SCO DE,"P") W !,"**",SCO DE," ",IEN | |
482 | . . I IEN S Y=$O(^C HMSERV(IEN ,1,0)) I Y ,'$P($G(^C HMSERV(IEN ,1,Y,0)),U ) S $P(^CH MSERV(IEN, 1,Y,0),U)= 3110930 W !,SCODE," done",! ZW ^CHMSERV( IEN,1) W ! Q | |
483 | . . S SCO DE=$O(^CHM SERV("B",S CODE)) | |
484 | . Q | |
485 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.