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 | CHIVFI3.m | Mon Nov 5 16:41:38 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHIVFI3.m | Fri Nov 9 01:27:15 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 4 | 1022 |
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 | CHIVFI3 ;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 | ;;10/4/16 DPT MTN02 6936 FY201 7 ROUTINE IS A CLONE OF CHIVFI 2, BYPASS READING FR OM MAPPING TOOL READ AND LOAD FROM _CHAN GE_ FILE | |
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 ICDENV= $ZU(5) | |
34 | S:ICDENV= "HAC" IOBA SE="HAC_HF S$:[SCR.TE MP_FILES.F S3BIG.CODE UPDT.ICD10 UPDT.FY201 3]" | |
35 | S:ICDENV' ="HAC" IOB ASE="MISC7 $:[DSMMANA G.CHAMPVA. TEMP_FILES .FS3BIG.CO DEUPDT.ICD 10UPDT.FY2 013]" | |
36 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
37 | ;S EDT="1 0/1/2014" D READ1 | |
38 | S IO=IOBA SE_"ICD10C M_APPVD_03 _24_2014_1 2_41_14.CS V" | |
39 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
40 | S DATA("R T")="D" | |
41 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
42 | ; | |
43 | ; PCS | |
44 | ; | |
45 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
46 | S IO=IOBA SE_"ICD10P CS_APPVD_0 3_24_2014_ 12_42_13.C SV" | |
47 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
48 | S DATA("R T")="P" | |
49 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
50 | Q | |
51 | AUTO2014(E FFDT) ; | |
52 | S AUTO=1 | |
53 | W #,"Begi nning Load of FY2014 Mapping T ool files" H 1 | |
54 | S AUTO=1 | |
55 | K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y | |
56 | K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J | |
57 | S $ZE="" | |
58 | I $G(EFFD T)="" S EF FDT=314101 0 | |
59 | S X1=EFFD T,X2=-1 D C^%DTC | |
60 | S TERMDT= X | |
61 | ; | |
62 | K SFILES | |
63 | ;09/29/15 SBB DEF01 6554 fix f or decnet | |
64 | ;S IOBASE ="HACFS3"" DNS HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10UP DT.FY2014] " | |
65 | S ICDENV= $ZU(5) | |
66 | S:ICDENV= "HAC" IOBA SE="HAC_HF S$:[SCR.TE MP_FILES.F S3BIG.CODE UPDT.ICD10 UPDT.FY201 4]" | |
67 | S:ICDENV' ="HAC" IOB ASE="MISC7 $:[DSMMANA G.CHAMPVA. TEMP_FILES .FS3BIG.CO DEUPDT.ICD 10UPDT.FY2 014]" | |
68 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
69 | ;S EDT="1 0/1/2014" D READ1 | |
70 | S IO=IOBA SE_"ICD10C M_APPVD_AU G2013_07_0 8_2014_08_ 36_21.csv" | |
71 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
72 | S DATA("R T")="D" | |
73 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
74 | ; | |
75 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
76 | S IO=IOBA SE_"ICD10C M_APPVD_JA N2014_07_2 3_2014_13_ 07_11.csv" | |
77 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
78 | S DATA("R T")="D" | |
79 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
80 | ; | |
81 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
82 | S IO=IOBA SE_"ICD10C M_APPVD_MA R2014_07_2 8_2014_12_ 10_35.csv" | |
83 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
84 | S DATA("R T")="D" | |
85 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
86 | ; | |
87 | ; PCS | |
88 | ; | |
89 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
90 | S IO=IOBA SE_"ICD10P CS_APPVD_A UG2013_07_ 08_2014_08 _36_49.csv " | |
91 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
92 | S DATA("R T")="P" | |
93 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
94 | ; | |
95 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
96 | S IO=IOBA SE_"ICD10P CS_APPVD_J AN2014_07_ 23_2014_13 _08_11.csv " | |
97 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
98 | S DATA("R T")="P" | |
99 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
100 | ; | |
101 | D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT | |
102 | S IO=IOBA SE_"ICD10P CS_APPVD_M AR2014_07_ 28_2014_12 _05_48.csv " | |
103 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
104 | S DATA("R T")="P" | |
105 | D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP | |
106 | Q | |
107 | ; | |
108 | EN ; entry point for ingesting data file (s) | |
109 | ; | |
110 | K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y | |
111 | K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J | |
112 | S $ZE="" | |
113 | ;S $ZT="E OF^CHIVFI2 " ; necess ary error trapping l ogic for p rocess to complete | |
114 | ; Modules called: | |
115 | ; INIT = initialize variables | |
116 | ; HDR = prints pro cess page header | |
117 | ; READ = gets file type and f ile data I O string. Also gets Vendor nam e if a (B) ase file l oad | |
118 | ; OPEN = opens the file retur ned in the IO string from the READ modul e | |
119 | ; LOAD = loads file data into a tempora ry global for proces sing. The temporary global is defined in the INIT module | |
120 | ; | |
121 | D INIT,HD R,READ,HDR :'STOP,OPE N:'STOP,LO AD:'STOP | |
122 | ; | |
123 | EN1 ; cont inue proce ssing -lg | |
124 | ; 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 | |
125 | ; 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 | |
126 | ; to the screen and processin g will com e to a sto p and retu rn the use r to the m enu option . | |
127 | ; call to parse dat a for inst allation t o Diagnosi s file (#7 41006.05) and Servic es file (# 741006) | |
128 | ; Modules called: | |
129 | ; 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 | |
130 | ; PARSEM = module i n this rou tine calle d to proce ss (M)appi ng type da ta files | |
131 | ; | |
132 | D:'STOP P ARSEM | |
133 | I 'STOP D ; print process st atistics i f processi ng complet e | |
134 | .S DATA(" CTM")=$$NO W^CHIUTIL( ) | |
135 | .W !," T he "_$S(DA TA("LDTYP" )="B":"ICD -10",1:"") _" load pr ocess is C omplete!", ?38," : ", DATA("CTM" ) | |
136 | .W !!,$E( LN,1,41),! | |
137 | .; put lo ad statist ics here * * | |
138 | .W !," Pro cessing St arted : ", DATA("STTM ") | |
139 | .W !," FileM an Load St arted : ", DATA("FMTM ") | |
140 | .W !," Proce ssing Comp leted : ", DATA("CTM" ) | |
141 | .W !!," Total ICD Diagnosis Codes : " ,$J(DATA(" DXCNT"),7) | |
142 | .W !," Total ICD Procedure Codes : ", $J(DATA("P CSCNT"),7) | |
143 | .W !," Total Codes : ", $J(DATA("D XCNT")+DAT A("PCSCNT" ),7) | |
144 | .I 'MMODE ,$G(DATA(" D")) D | |
145 | ..W !," Total D Status R ecords : " ,$J(DATA(" D"),7) | |
146 | ..W !," Subtotal Added to F ile(s) : " ,$J((DATA( "DXCNT")+D ATA("PCSCN T"))-DATA( "D"),7) | |
147 | ..Q | |
148 | .Q | |
149 | W !!,$E(L N,1,41),! | |
150 | R:$G(AUTO )'=1 !!," Press <E nter> to c ontinue ", *X | |
151 | ; if in m aitenance mode print the recor d status' | |
152 | I 'STOP,$ G(DATA("LD TYP"))="M" ,MMODE W @ IOF,$E(LN, 1,41),!! D Q | |
153 | .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 | |
154 | ..W !," Total ",X ," Records : ",$J(+$ G(DATA(X)) ,7) | |
155 | ..Q | |
156 | .W !!,$E( LN,1,41),! | |
157 | .R:$G(AUT O)'=1 !!," Press < Enter> to continue " ,*X | |
158 | .Q | |
159 | ; | |
160 | K @GLOBAL ; kill d ata in tem porary sto rage globa l | |
161 | Q | |
162 | INIT ; iti alize some required variables | |
163 | ; | |
164 | N MM,DD | |
165 | S U="^",D UZ=1,DUZ(0 )="@" ; *** FOR TESTING * ** -lg | |
166 | 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 | |
167 | ; | |
168 | S GLOBAL= "^UTILITY( $J,""ICD"" )" K @GLOB AL ; tempora ry data st orage glob al | |
169 | S STOP=0, $P(LN,"_", 80)="" ; process ing STOP f lag, line characters | |
170 | S (DATA(" DXCNT"),DA TA("PCSCNT "))=0 ; Diagnos is and Pro cedure rec ord counte rs | |
171 | S MMODE=1 ; MMODE = maintenan ce mode | |
172 | S DATA("D ATE")=$P($ $FMDT^CHIU TIL(),".") ; today's date | |
173 | ; set eff ective yea r - effect ive and te rmination dates alwa ys 10/01 a nd 09/30 r espectivel y | |
174 | ; 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 | |
175 | S DATA("Y R")=$E(DAT A("DATE"), 1,3)-(($E( DATA("DATE "),4,5))'> 9) ; effec tive year | |
176 | S DATA("E FFDATE")=D ATA("YR")_ "1001" ; effecti ve date always Oct 1st | |
177 | S DATA("T ERMDATE")= DATA("YR") _"0930" ; termina tion date always Sep 30th | |
178 | Q | |
179 | OPEN ; OPE N vendor d ata file | |
180 | ; | |
181 | W !!," S tarting... " ; messag e to indic ate ingest process i s starting | |
182 | O IO:"R": 10 ; open load file with a 10 second tim eout | |
183 | ; if unab le to open the file notify the user and set the 'S TOP' flag to stop al l further processing | |
184 | I '$T D S STOP=1 Q | |
185 | .W !!,"Un able to op en "_DATA( "FILE"),!! ,"Please m ake sure t he file na me is corr ect.",!! | |
186 | Q | |
187 | READ ; pro mpt user t o select d ata file f or ingest | |
188 | ; | |
189 | ;K IN S I N=0,IN("DI R")="HACFS 3"" DNS HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10MA PPINGTOOL. MAINT]" | |
190 | ;S IN("FI LES")="*.C SV" | |
191 | S IO=$$ME NU^CHICDOL (.IN,.SEL, 0) I IO="" S STOP=1 Q | |
192 | ;S IO=$$M ENU^CHICDO L(.IN,.SEL ,1) I IO=" " S STOP=1 Q | |
193 | ;S SEL("F ILETYPE")= "C" ;10/4/ 16 DPT | |
194 | S SEL("FI LETYPE")=" M" | |
195 | ; get dat a filename and data file type: either (B )ase or (M )apping or (C)hange | |
196 | S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M" | |
197 | ; get rec ord type i n data fil e: either Diagnosis or Procedu re code re cords | |
198 | S DATA("R T")=$S(SEL ("CODETYPE ")="C":"D" ,1:"P") | |
199 | ; change the date l ogic from what origi nal was do ing to fil ename date forwarded to next F Y border | |
200 | S CHG="", CHG=$S(IO[ "CHANGE":" CHG") | |
201 | S EDT=$G( SEL("WNAME ")) Q:EDT= "" | |
202 | 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:"") | |
203 | S EDT=$P( EDT,"_",1, 3),EDT=$P( EDT," "),E DT=$TR(EDT ,"_","/") | |
204 | S:$P(EDT, "/",3)?2N $P(EDT,"/" ,3)="20"_$ P(EDT,"/", 3) | |
205 | ;S EDT=$P (EDT,"_",3 )-1700_$P( EDT,"_")_$ P(EDT,"_", 2) | |
206 | ;S DATA(" DATE")=EDT | |
207 | ;S DATA(" YR")=$E(DA TA("DATE") ,1,3)-(($E (DATA("DAT E"),4,5))' >9)+1 ; ef fective ye ar | |
208 | S OK=0 | |
209 | READ1 ; | |
210 | F D Q:O K'=0 | |
211 | . S %DT(" A")="Pleas e enter th e Effectiv e Date for this load : " | |
212 | . S %DT(" B")="10/01 /"_($P(EDT ,"/",3)+1) | |
213 | . ;E S % DT("B")=ED T | |
214 | . S %DT=" AE" | |
215 | . I '$D(D T) D NOW^% DTC S DT=X | |
216 | . ;S %DT( 0)=DT | |
217 | . D ^%DT | |
218 | . I X="^" S OK=-1,S TOP=1 Q | |
219 | . ;I Y<DT W !!,"Ple ase select a date th at is not in the pas t.",! Q | |
220 | . ;I Y<ED T W !,"You can't pic k the date before th e spreadsh eet date" Q | |
221 | . S EFFDT =Y | |
222 | . W !,"Th e Effectiv e Date for this main tenance lo ad will be : " D DD^% DT W Y | |
223 | . S DATA( "EFFDATE") =EFFDT | |
224 | . S X1=EF FDT,X2=-1 D C^%DTC | |
225 | . S DATA( "TERMDATE" )=X | |
226 | . W !,"Ar e you sure : " S %=1 D YN^DICN | |
227 | . I %=-1 S OK=-1,ST OP=1 Q | |
228 | . I %=1 S OK=1 | |
229 | I OK=-1 Q | |
230 | ;S DATA(" EFFDATE")= DATA("YR") _"1001" ; effect ive date always Oc t 1st | |
231 | ;S DATA(" TERMDATE") =DATA("YR" )_"0930" ; termin ation date always Se p 30th | |
232 | Q | |
233 | HDR ; do a pagefeed and then p rint the p rocess hea der to the screen | |
234 | ; | |
235 | W @IOF,!, " THE HAC CHAMPVA I CD-10 MAIN TENANCE LO AD PROCESS ",!,$E(LN, 1,51),! | |
236 | Q | |
237 | ; | |
238 | LOAD ; loa d the data file | |
239 | ; | |
240 | S DATA("S TTM")=$$NO W^CHIUTIL( ) ; start time | |
241 | W !!," . .. *Proces sing Mappi ng Tool Up date* ..." | |
242 | W !!," P rocessing data file. .. ",D ATA("FILE" ),!!?20,"P rocessing Started : ",DATA("ST TM") | |
243 | W !!," . .. Please be patient ",!," ... wait for processing to comple te",!! | |
244 | S A=$ZUTI L(68,40,1) K @GLOBAL | |
245 | U IO F Y= 1:1 R X Q: $ZEOF=-1 Q:X="" S @GLOBAL@(Y )=X | |
246 | C IO | |
247 | Q | |
248 | ; | |
249 | ; | |
250 | PARSEM ; p arse AI ma pping data for add t o DX and P CS file | |
251 | ; | |
252 | U 0 S $ZT ="" | |
253 | S DATA("F MTM")=$$NO W^CHIUTIL( ) ; FileMa n load sta rt time | |
254 | W !?18,"F ileMan Loa d Started : ",DATA(" FMTM") | |
255 | W !!," . .. Parsing the mappi ng tool fi le",! | |
256 | ; set up DATA array with Optu m vendor d ata (start Y=2 to by pass heade rs) | |
257 | F BY=2:1 S SL=$G(@G LOBAL@(BY) ) Q:SL="" D PARSEM1 | |
258 | Q | |
259 | PARSEM1 ; | |
260 | ; | |
261 | ; *** 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 | |
262 | 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 | |
263 | ; | |
264 | I CHG="CH G" D | |
265 | .S DATA ("CODE")=$ P(SL,U,1) ; DPT MTN 026936 | |
266 | .S DATA ("STATUS") =$P(SL,U,2 ) ; DPT MT N026936 | |
267 | .S DATA ("TERMDT") =$P(SL,U,6 ) ; DPT MT N026936 | |
268 | .S DATA ("OLD_DESC ")=$E($P(S L,U,8),1,4 8) ; DPT M TN026936 | |
269 | .S DATA ("NEW_DESC ")=$E($P(S L,U,9),1,4 8) ; DPT M TN026936 | |
270 | .S DATA ("CODE_TYP E")=$P(SL, U,10) ; D PT MTN0269 36 | |
271 | .S DATA ("SUBDIV") ="" ; DPT MTN026936 | |
272 | I CHG'="C HG" D | |
273 | .S DATA( "CODE")=$T R($P(SL,U) ,"x","X") ; ICD code | |
274 | .S DATA( "NAME")=$P (SL,U,2) ; Code Nam e | |
275 | .S DATA( "CVA")=+$P (SL,U,5) ; ChampVA AI test va lue - CVA is ie n #1 in fi le #741002 .94 | |
276 | .S DATA( "SB")=+$P( SL,U,6) ; Spina Bi fida AI te st value - SB is ie n #6 in fi le #741002 .94 | |
277 | ; next t wo lines a re to chan ge CVA and SB value from exter nal to int ernal IEN format | |
278 | ;S DATA( "CVA")=$O( ^DIC(74110 0,"B","TES T #"_DATA( "CVA"),"") ) | |
279 | ;S DATA( "SB")=$O(^ DIC(741100 ,"B","TEST #"_DATA(" SB"),"")) | |
280 | ;S DATA( "DUZ")=$P( SL,U,12) ; DUZ of u ser approv ing AI tes t mapping | |
281 | ;S DATA( "DT")=$P(S L,U,13) ; date use r approved AI test m apping | |
282 | ;S DATA( "STATUS")= $P(SL,U,14 ) ; Optum status | |
283 | ; If it i s incomple te, don't stamp 0, d elete the data with "@". File man is def ined as | |
284 | ; set of codes 1:SU BDIVIDED C ODE; so 0 is not val id value. | |
285 | .S DATA( "SUBDIV")= $S($P(SL,U ,15)="I":1 ,1:"@") ; Optum Comp lete | |
286 | ; | |
287 | ;I CHG="C HG" D | |
288 | ; .S IEN= +$$GETIEN^ CHIVFI($S( DATA("STAT US")'="D": $TR(DATA(" CODE"),"." ),1:DATA(" CODE")),DA TA("STATUS ")) ; modu le to matc h the code in the CH ANGE file with the I EN in the live file | |
289 | ;I CHG'=" CHG" D | |
290 | 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 | |
291 | ;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 | |
292 | ; next fe w cases ch eck 'Statu s' of reco rd | |
293 | ; N = NEW | |
294 | ; C = CHA NGE | |
295 | ; D = DEL ETED | |
296 | ; R = REI NSTATED | |
297 | ; U = UNO FFICIAL CH ANGE | |
298 | ;;W !,DAT A("STATUS" )," / ",$G (IEN)," / ",SL | |
299 | S I=$I(DA TA(DATA("S TATUS"))) | |
300 | I DATA("S TATUS")="D " D DEACT ; set te rmination date | |
301 | I DATA("S TATUS")="R " D REACT ; see RE ACT module | |
302 | I DATA("S TATUS")="C "!(DATA("S TATUS")="U ") D CHANG E(IEN) | |
303 | I DATA("S TATUS")="N " D ADD ; populate appropriat e file | |
304 | ; count c ode types for stats | |
305 | S @$S(DAT A("RT")="D ":"DATA("" DXCNT"")=D ATA(""DXCN T"")+1",1: "DATA(""PC SCNT"")=DA TA(""PCSCN T"")+1") | |
306 | I $X>0 W !,BY," ",S L,! | |
307 | Q | |
308 | ; | |
309 | DEACT ; co de deactiv ation | |
310 | ; Nothing to deacti vate | |
311 | I 'IEN Q | |
312 | ; Set DX terminatio n date | |
313 | I DATA("R T")="D" D | |
314 | . Q:'$D(^ CHMICDX(IE N,0)) | |
315 | . S:$P(^C HMICDX(IEN ,0),U,23)= "" $P(^CHM ICDX(IEN,0 ),U,23)=DA TA("TERMDA TE") | |
316 | . ;S Y=$O (^CHMICDX( IEN,103,0) ) Q:'Y | |
317 | . ;S:$P(^ CHMICDX(IE N,103,Y,0) ,U,2)="" $ P(^CHMICDX (IEN,103,Y ,0),U,2)=D ATA("TERMD ATE") | |
318 | . Q | |
319 | ; PCS is defined wi th the mos t recent h istory ent ry being a ctive | |
320 | I DATA("R T")="P" D | |
321 | . S Y=$O( ^CHMSERV(I EN,1,0)) Q :'Y | |
322 | . Q:$P($G (^CHMSERV( IEN,1,Y,0) ),U)'="" ; If alread y terminat ed, we are done | |
323 | . 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 | |
324 | . Q | |
325 | Q | |
326 | REACT ; co de mainten ace reacti vation (R: reinstated ) | |
327 | ; *** 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 | |
328 | I DATA("R T")="D" D Q | |
329 | . I 'IEN D DXI Q ; add ICD c ode if ICD code not found in f ile | |
330 | . ; clear terminati on date | |
331 | . D CHANG E(IEN) ; c all CHANGE to create history a nd save da ta | |
332 | . ; clear terminati on date | |
333 | . S $P(^C HMICDX(IEN ,0),U,23)= "" | |
334 | . Q | |
335 | I DATA("R T")="P" D Q | |
336 | . I 'IEN D PCSI Q ; add ICD code if IC D code not found in file | |
337 | . ; *** 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 | |
338 | . ;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)="" | |
339 | . D CHANG E(IEN) ; c all CHANGE just in c ase there are additi onal chang es beside just reins tating the code | |
340 | Q | |
341 | CHANGE(DA) ; for cod es with a status of C:change U :unofficia l change R :reinstate d | |
342 | ; | |
343 | S DIE=$S( DATA("RT") ="D":"^CHM ICDX(",1:" ^CHMSERV(" ) | |
344 | I +$G(IEN )=0 G ADD | |
345 | D DXIC:DA TA("RT")=" D",PCSIC:D ATA("RT")= "P" | |
346 | Q | |
347 | ; | |
348 | ADD | |
349 | I IEN D Q | |
350 | . ; There is record already f or some re ason | |
351 | . K DA S DA=IEN D D XIC:DATA(" RT")="D",P CSIC:DATA( "RT")="P" | |
352 | D DXI:DAT A("RT")="D ",PCSI:DAT A("RT")="P " | |
353 | Q | |
354 | ; mapping file inge st FileMan call to p opulate AI test Prog ram Indica tor multip le | |
355 | ;S DA=IEN ,DIE=$S(DA TA("RT")=" D":"^CHMIC DX(",1:"^C HMSERV(") | |
356 | ;F CT="CV A","SB" D | |
357 | ;. S DATA (.01)=$S(C T="CVA":1, 1:6),DATA( .02)=DATA( CT),DATA(. 03)=DATA(" DUZ") | |
358 | ;. S DATA (.04)=DATA ("DT") | |
359 | ;. I DATA ("RT")="D" D | |
360 | ;. . 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) | |
361 | ;. . 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)" | |
362 | ;. I DATA ("RT")="P" D | |
363 | ;. . 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) | |
364 | ;. . 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)" | |
365 | ;. S DIC= DIE,DIC(0) ="L" D ^DI E | |
366 | Q | |
367 | DXI ; make FileMan c all to pop ulate CHAM PVA ICD DI AGNOSIS fi le (#74100 6.05) | |
368 | ; create a new reco rd | |
369 | 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 | |
370 | S $P(^CHM ICDX(0),U, 4)=$P(^CHM ICDX(0),U, 4)+1 | |
371 | DXIC ; mid -entry poi nt to make changes t o existing DX codes | |
372 | ; SET Fil eMan DR va riable (fi eld edit s tring) | |
373 | S DIE="^C HMICDX(",D IC=DIE | |
374 | ; create history fo r old entr y | |
375 | I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D | |
376 | . N DINUM ,SUB,DABK | |
377 | . S DABK= DA | |
378 | . ; 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 | |
379 | . 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 ) | |
380 | . S:DATA( "STATUS")' ="R" OTERM =DATA("TER MDATE") | |
381 | . S (DINU M,SUB)=(99 99999-OED) | |
382 | . K DR S DR="103/// ^S X=OED" | |
383 | . 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) | |
384 | . S DR(2, 741006.051 03)=".01// /^S X=OED; .02///^S X =OTERM;.03 ///^S X=ON AME;.04/// ^S X=OSUBD IV" | |
385 | . S DIC=D IE,DIC(0)= "L" D ^DIE | |
386 | . K DA S DA=DABK | |
387 | . I OSUBD IV=1 S DAT A("SUBDIV" )=1 ; DPT MTN026936 | |
388 | I CHG="CH G" D | |
389 | .K DR S D R=".01//// ^S X=DATA( ""NEW_DESC "");1///^S X=DATA("" CODE"");2/ ///D" ; DP T MTN02693 6 | |
390 | .S DR=DR_ ";22///^S X=DATA(""E FFDATE""); 24////1" ; DPT MTN02 6936 | |
391 | .S DIC=DI E,DIC(0)=" L" D ^DIE Q ; DPT MT N026936 | |
392 | I CHG'="C HG" | |
393 | .S DATA( "CAT")=$L( $TR(DATA(" NAME"),"." )),DATA("C AT")=$S(DA TA("CAT")= 3:1,DATA(" CAT")=4:2, DATA("CAT" )=5:3,1:4) ;define c ategory fi eld#3 ;ICD -10 RCS Bu g 36 | |
394 | .K DR S D R=".01//// ^S X=DATA( ""NAME""); 1///^S X=D ATA(""CODE "");2////D " | |
395 | .S DR=DR_ ";3////^S X=DATA(""C AT"");15// /^S X=DATA (""SUBDIV" ");24////1 " | |
396 | .S DR=DR_ ";22///^S X=DATA(""E FFDATE"")" | |
397 | .S DIC=DI E,DIC(0)=" L" D ^DIE I $X>0 S G LAZBR=1 | |
398 | I CHG'="C HG" D MFI ; DPT MT N026936 | |
399 | Q | |
400 | PCSI ; mak e FileMan call to po pulate CHA MPVA SERVI CES file ( #741006) | |
401 | 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 | |
402 | S $P(^CHM SERV(0),U, 4)=$P(^CHM SERV(0),U, 4)+1 | |
403 | PCSIC ; mi d-entry po int to mak e changes to existin g PCS code s | |
404 | S DIE="^C HMSERV(",D IC=DIE | |
405 | S OLDR=$G (^CHMSERV( DA,0)) | |
406 | S DATA("O SUBDIV")=$ P(OLDR,U,9 ) | |
407 | I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D | |
408 | . ; termi nate curre nt PCS cod e descript ion before applying change *** -lg 3/7/1 2 | |
409 | . ; for P CS change must first terminate existing descriptio n *** -lg 3/7/12 | |
410 | . ; 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 | |
411 | . S Y=$O( ^CHMSERV(D A,1,0)) I Y D Q | |
412 | . . I Y=( 9999999-DA TA("EFFDAT E")) K ^CH MSERV(DA,1 ,Y) Q | |
413 | . . 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") | |
414 | . . I DAT A("OSUBDIV ")=1 S DAT A("SUBDIV" )=1 ; DPT MTN026936 | |
415 | ; update main recor d | |
416 | K DR S DR =".01///"_ $TR(DATA(" CODE"),"." )_";.05/// ^S X=""ICD -10"";.09/ //^S X=DAT A(""SUBDIV "")" | |
417 | S DIC=DIE ,DIC(0)="L " D ^DIE | |
418 | ; update the | |
419 | N DINUM,S UB | |
420 | S (DINUM, SUB)=(9999 999-DATA(" EFFDATE")) ; DI NUM to set uncoventi onal 'END DATE' mult iple struc ture | |
421 | ; 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 | |
422 | K DR S DR ="1///^S X =DATA(""EF FDATE"")" | |
423 | I CHG="CH G" D | |
424 | .I DAT A("STATUS" )="N" S DR (2,741006. 01)=".09// /^S X=DATA (""EFFDATE "");30.01/ //^S X=DAT A(""NEW_DE SC"");.1// /^S X=DATA (""SUBDIV" ")" Q ; DP T MTN02693 6 | |
425 | .S DR(2 ,741006.01 )=".01///^ S X=DATA(" "EFFDATE"" );.09///^S X=DATA("" EFFDATE"") ;30.01///^ S X=DATA(" "NEW_DESC" ");.1///^S X=DATA("" SUBDIV"")" ; DPT MTN 026936 | |
426 | I CHG'="C HG" D | |
427 | .S DR(2, 741006.01) =".01///^S X=DATA("" EFFDATE"") ;.09///^S X=DATA(""E FFDATE""); 30.01///^S X=DATA("" NAME"");.1 ///^S X=DA TA(""SUBDI V"")" | |
428 | ; if it i s already there, kil l it, we a re setting it again | |
429 | K ^CHMSER V(DA,1,DIN UM) | |
430 | S DIC=DIE ,DIC(0)="L " D ^DIE | |
431 | S $P(^CHM SERV(DA(1) ,1,SUB,0), U)="" ; se t uncovent ional 'END DATE' mul tiple .01 field equa l to "" | |
432 | 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 | |
433 | I CHG'=" CHG" D MFI ; DPT MTN 026936 | |
434 | Q | |
435 | MFI ; | |
436 | ; mapping file inge st FileMan call to p opulate AI test Prog ram Indica tor multip le | |
437 | 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 | |
438 | K DA S DA =IEN,DIE=$ S(DATA("RT ")="D":"^C HMICDX(",1 :"^CHMSERV (") | |
439 | S TG=$E(D IE,1,*-1) | |
440 | ;F PI="CV A","SB" D | |
441 | . ;S DATA ("PI")=$S( PI="CVA":1 ,1:6),DATA ("AI")=DAT A(PI),DA(1 )=DATA("PI ") | |
442 | . ;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) | |
443 | . ;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"")" | |
444 | . ;S DIC= DIE,DIC(0) ="L" D ^DI E | |
445 | I DATA("C VA")'="" D | |
446 | . I $D(@T G@(IEN,102 ,1,0)) | |
447 | . . S HN= $O(@TG@(IE N,102,1,10 1,"A"),-1) +1 | |
448 | . . I DAT A("CVA")=$ P(@TG@(IEN ,102,1,0), "^",2) Q | |
449 | . . S @TG @(IEN,102, 1,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN | |
450 | . . S @TG @(IEN,102, 1,101,HN,0 )=@TG@(IEN ,102,1,0) | |
451 | . . S @TG @(IEN,102, 1,101,"B", 1,HN)="" | |
452 | . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT") | |
453 | . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,1 ,0)),"^",3 ) | |
454 | . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,1,0 )),"^",4) | |
455 | . S @TG@( IEN,102,1, 0)="1^"_DA TA("CVA")_ "^"_DDUZ_" ^"_DDT | |
456 | . S @TG@( IEN,102,"B ",1,1)="" | |
457 | I DATA("S B")'="" D | |
458 | . I $D(@T G@(IEN,102 ,6,0)) | |
459 | . . S HN= $O(@TG@(IE N,102,6,10 1,"A"),-1) +1 | |
460 | . . I DAT A("SB")=$P (@TG@(IEN, 102,6,0)," ^",2) Q | |
461 | . . S @TG @(IEN,102, 6,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN | |
462 | . . S @TG @(IEN,102, 6,101,HN,0 )=@TG@(IEN ,102,6,0) | |
463 | . . S @TG @(IEN,102, 6,101,"B", 1,HN)="" | |
464 | . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT") | |
465 | . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,6 ,0)),"^",3 ) | |
466 | . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,6,0 )),"^",4) | |
467 | . S @TG@( IEN,102,6, 0)="6^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT | |
468 | . S @TG@( IEN,102,"B ",6,6)="" | |
469 | I DATA("S B")'="" D | |
470 | . I $D(@T G@(IEN,102 ,7,0)) | |
471 | . . S HN= $O(@TG@(IE N,102,7,10 1,"A"),-1) +1 | |
472 | . . I DAT A("SB")=$P (@TG@(IEN, 102,7,0)," ^",2) Q | |
473 | . . S @TG @(IEN,102, 7,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN | |
474 | . . S @TG @(IEN,102, 7,101,HN,0 )=@TG@(IEN ,102,7,0) | |
475 | . . S @TG @(IEN,102, 7,101,"B", 1,HN)="" | |
476 | . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT") | |
477 | . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,7 ,0)),"^",3 ) | |
478 | . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,7,0 )),"^",4) | |
479 | . S @TG@( IEN,102,7, 0)="7^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT | |
480 | . S @TG@( IEN,102,"B ",7,7)="" | |
481 | I DATA("C VA")+DATA( "SB") D | |
482 | . S X=0 F I=0:1 S X =$O(@TG@(I EN,102,X)) Q:'X | |
483 | . S @TG@( IEN,102,0) ="^741006. 0"_$S(DATA ("RT")="D" :5102,1:10 2)_"^"_$O( @TG@(IEN,1 02,"A"),-1 )_"^"_I | |
484 | Q | |
485 | ; | |
486 | EOF ; come here on e nd of file error; OR ANY OTHER error -lg | |
487 | ; | |
488 | S ER=$ZE | |
489 | I IO'="" C IO U 0 | |
490 | I ER["<EN DOFFILE>" D G EN1 ; continue on with l oad @EN1 | |
491 | .W !," . .. End of File reach ed ...",!! ," ... St arting Fil eMan file load ... " ,! | |
492 | .S DATA(" FMTM")=$$N OW^CHIUTIL () ; FileM an load st art time | |
493 | .W !?18," FileMan Lo ad Started : ",DATA( "FMTM") | |
494 | .Q | |
495 | I ER'="" W !!," *** A System error has occurred! ***",!!?4, ER,!! | |
496 | W $E(LN,1 ,39),! | |
497 | R !!," Press <Ent er> to con tinue ",*X | |
498 | Q | |
499 | TERMINATE ; | |
500 | F R !,CO DE D | |
501 | . S IEN=0 | |
502 | . I CODE? 1"S42".E D Q | |
503 | . . S IEN =$$GETIEN^ CHIVFI(COD E,"D") | |
504 | . . 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 | |
505 | . I CODE' ["-" D Q | |
506 | . . S IEN =$$GETIEN^ CHIVFI(COD E,"P") W ! ,"*",CODE, " ",IEN | |
507 | . . 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 | |
508 | . S CODE= $TR(CODE," "),SCODE= $P(CODE,"- ") | |
509 | . F D Q :SCODE>$P( CODE,"-",2 ) | |
510 | . . S IEN =$$GETIEN^ CHIVFI(SCO DE,"P") W !,"**",SCO DE," ",IEN | |
511 | . . 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 | |
512 | . . S SCO DE=$O(^CHM SERV("B",S CODE)) | |
513 | . Q | |
514 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.