Produced by Araxis Merge on 11/9/2018 12:33:47 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 | CHICDAI.m | Mon Nov 5 16:42:08 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHICDAI.m | Fri Nov 9 01:21:35 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 3504 |
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 | CHICDAI ; | |
2 | ; | |
3 | ; CU RRENTPX 281 PCS | |
4 | ; DI AGNOSES FO R CLAIM 19 DX | |
5 | ; OT HER PROCED URES SAME DAY 74 PCS | |
6 | ; PR OCEDURE 47 PCS | |
7 | ; PR OCEDURES F OR CLAIM 15 PCS | |
8 | ; CU RRENT NDC CODE 12 0 Neithe r | |
9 | ; DIAGN OSIS PRIMA RY 263 DX | |
10 | Q | |
11 | ; | |
12 | CNVT ; | |
13 | D SETUP | |
14 | ;R !,"Tes t IEN or n ame (RETUR N for ALL) : ",AIEN I AIEN'="" S:AIEN'?1. N AIEN=$O( @GLAZDIC@( 741100,"B" ,AIEN,"")) G:AIEN'=" "&$D(@GLAZ DIC@(74110 0,+AIEN)) ONEAI W !, "Not valid " Q | |
15 | S AIEN=0 F S AIEN= $O(@GLAZDI C@(741100, AIEN)) Q:' AIEN D ON EAI | |
16 | W !,"**** The AI T est Conver sion has s uccessfull y complete d ****" | |
17 | I '$D(^DD (741100.00 4)) W !,"A I Test INC LUDE HISTO RY NOUNS i nitializat ion failed since DD table is n ot updated yet" Q | |
18 | D HIST | |
19 | W !,"**** The AI Te st INCLUDE HISTORY N OUNS multi ple has be en initial ized" | |
20 | Q | |
21 | ONEAI ; | |
22 | S U="^" | |
23 | K STATUSD | |
24 | I '$G(ACT IVE(AIEN)) Q | |
25 | S WHEAD=A IEN_" "_$P (@GLAZDIC@ (741100,AI EN,0),"^") | |
26 | S RIEN=0, TTR=0 | |
27 | S MAX=1 ; max numbe r of codes we are no t replacin g with lis t | |
28 | F S RIEN =$O(@GLAZD IC@(741100 ,AIEN,100, RIEN)) Q:' RIEN D | |
29 | . S STATU S="AS-IS" | |
30 | . K AI M AI=@GLAZDI C@(741100, AIEN,100,R IEN,100) | |
31 | . K NOUN, TAI,ICD10L S TEIEN=0 | |
32 | . ; check if any of the affec ted nouns are presen t and make list | |
33 | . S TR=0 | |
34 | . F EIEN= 1:1 Q:'$D( AI(EIEN)) D | |
35 | . . ; cla ssify elem ent as (1) as is, (2 ) ICD10 or (3) new l ist | |
36 | . . S ELT YP=1,NIEN= "" | |
37 | . . F NIE NZ=15,19,4 7,74,120,2 63,281,297 ,298,307,3 08 D | |
38 | . . . Q:' $F(AI(EIEN ,1),"$n"_N IENZ_"^$o" ) S NIEN= NIENZ | |
39 | . . . S O PER=+$P(AI (EIEN,1)," $o",2),VAL =$TR($P(AI (EIEN,1)," ^$o"_OPER_ "^",2),""" ") | |
40 | . . . ; f ound in/no t found in (remediat e list) | |
41 | . . . I O PER=8!(OPE R=9) D Q | |
42 | . . . . K VALLIST S LISTIEN=$ P(VAL,"n", 2),L1=0 | |
43 | . . . . S LISTGL="^ "_$P(@GLAZ DIC@(74110 0.01,LISTI EN,1),"^", 6),EXPANDI NG=" expan ding list " | |
44 | . . . . S LISTSZ=$P ($G(@(LIST GL_"0)")), "^",4) | |
45 | . . . . F S L1=$O( @(LISTGL_" L1)")) Q:' L1 D | |
46 | . . . . . S ICD9=@( LISTGL_"L1 ,0)") | |
47 | . . . . . S LISTCNT =$$EXICD9( NIEN,ICD9, .VALLIST,L ISTGL_"""B "")") | |
48 | . . . . . I LISTCNT >1 S STATU S="LIST "_ LISTIEN_" EXPANDED" | |
49 | . . . . . ;I LISTCN T>1 S EXPA N(AIEN,RIE N,1)=@GLAZ DIC@(74110 0.01,LISTI EN,0) I EX PANDING'=" " W !,PREF IX,EXPANDI NG,LISTIEN ," ",$P(@G LAZDIC@(74 1100.01,LI STIEN,0)," ^",3) S EX PANDING="" ,PREFIX="" | |
50 | . . . . . ;W !,"ICD 9=",ICD9," LISTCNT= ",LISTCNT | |
51 | . . . . S L1=0 | |
52 | . . . . F S L1=$O( @(LISTGL_" L1)")) Q:L 1="" K @( LISTGL_"L1 )") | |
53 | . . . . F L1=1:1:$G (VALLIST) S @(LISTGL _"L1,0)")= VALLIST(L1 ) S @(LIST GL_"""B"", VALLIST(L1 ),L1)")="" | |
54 | . . . . S $P(@(LIST GL_"0)")," ^",3,4)=$G (VALLIST)_ "^"_$G(VAL LIST) S:ST ATUS?1"LIS T "1.N1" E XPANDED".E STATUS=ST ATUS_" "_ LISTSZ_"-> "_$G(VALLI ST) | |
55 | . . . ; L T, GT, NLT , NGT, STA RTS, NOT S TARTS (<, >, !<, !>) | |
56 | . . . I O PER=2!(OPE R=3)!(OPER =6)!(OPER= 7)!(OPER=1 0)!(OPER=1 1) Q | |
57 | . . . ; E Q, NEQ | |
58 | . . . I O PER'=1,OPE R'=5 W 1/0 | |
59 | . . . ; n ot as is, so check i f part of ongoing li st or not | |
60 | . . . S E LTYP=2 | |
61 | . . . ; n o ongoing list so po tentially start one | |
62 | . . . I ' TR S TR=NI EN_"^$o"_O PER S ELTY P=3,ORV=+$ P(AI(EIEN, 1),"$v",2) Q | |
63 | . . . ;I TR=(NIEN_" ^$o"_OPER) W "." S T RCNT=TRCNT +1,NEWLIST (RIEN,$I(N EWLIST(RIE N)))=VAL,A TOL=1 | |
64 | . . ; if as is just copy elem ent across | |
65 | . . I ELT YP=1 M TAI ($I(TEIEN) )=AI(EIEN) S TAI(TEI EN,0)=TEIE N Q | |
66 | . . ; if element is potential ly part of new list, then ... | |
67 | . . I ELT YP=3 D Q: ELTYP=3 | |
68 | . . . K V ALLIST | |
69 | . . . S L ISTCNT=$$E XICD9(NIEN ,VAL,.VALL IST) | |
70 | . . . S E IEN1=EIEN, EIEN2=EIEN | |
71 | . . . F S EIEN1=$O (AI(EIEN1) ) Q:'EIEN1 Q:'$F(AI (EIEN1,1), "$n"_TR) S EIEN2=EI EN1,XX=$$E XICD9(NIEN ,$TR($P(AI (EIEN1,1), "^$o"_OPER _"^",2),"" ""),.VALLI ST),LISTCN T=LISTCNT+ XX | |
72 | . . . I L ISTCNT>MAX !((AIEN=34 8)&(RIEN=4 )) D Q | |
73 | . . . . ; commit to list | |
74 | . . . . ; check if this list exists and can be ma tched on C RC | |
75 | . . . . S LIEN=0,MA TCH=0,NEWC RC=0,MATCH L=0 | |
76 | . . . . F I=1:1:VAL LIST S NEW CRC=NEWCRC +$ZCRC(VAL LIST(I),7) | |
77 | . . . . ; W !,"NEWCR C=",NEWCRC | |
78 | . . . . F S LIEN=$ O(@GLAZDIC @(741100.0 1,LIEN)) Q :'LIEN D Q:MATCH | |
79 | . . . . . I $P($G(@ GLAZDIC@(7 41100.01,L IEN,1)),"^ ",6)="" Q | |
80 | . . . . . ;W !,"Att empting to match ",L IEN," ",@G LAZDIC@(74 1100.01,LI EN,0)," ", $$LISTCRC( LIEN)," ", NEWCRC | |
81 | . . . . . I $$LISTC RC(LIEN)=N EWCRC S MA TCH=LIEN Q | |
82 | . . . . ; Per Gene's request, matching i s disabled for these tests | |
83 | . . . . I AIEN=223 S MATCH=0, MATCHL=0 | |
84 | . . . . I AIEN=314 S MATCH=0, MATCHL=0 | |
85 | . . . . I MATCH S E XPAN(AIEN, RIEN,3)=$G (@GLAZDIC@ (741100.01 ,MATCH,0)) S STATUS= "MATCHED " _MATCH,MAT CHL=MATCH | |
86 | . . . . ; make new list | |
87 | . . . . I 'MATCH D | |
88 | . . . . . S FILENUM =741112.04 _AIEN_RIEN | |
89 | . . . . . ;S FILENA M="CHAMPVA AIFD CONV ERSION LIS T "_AIEN_" "_RIEN | |
90 | . . . . . ;S NOUNNA M="CONVERS ION TEST " _AIEN_" "_ RIEN | |
91 | . . . . . S FILENAM ="CHAMPVA AIFD CONVE RSION LIST "_$P(@GLA ZDIC@(7411 00,AIEN,0) ,U)_" "_RI EN | |
92 | . . . . . S NOUNNAM ="CONVERSI ON FOR "_$ P(@GLAZDIC @(741100,A IEN,0),U)_ " "_RIEN | |
93 | . . . . . S MATCHL= $$MKNNEW(F ILENUM,.FI LENAM,NOUN NAM) | |
94 | . . . . . S EXPAN(A IEN,RIEN,2 )=$G(DIC(7 41100.01,M ATCHL,0)) | |
95 | . . . . . ;w !,PREF IX," made new list " ,MATCHL," ",$P(EXPAN (AIEN,RIEN ,2),"^",3) S PREFIX= "" | |
96 | . . . . . S STATUS= "NEW LIST "_MATCHL | |
97 | . . . . . S STATUSD ($I(STATUS D))=MATCHL _" = "_$G( DIC(741100 .01,MATCHL ,0)) | |
98 | . . . . . M @GLAZDD =DD | |
99 | . . . . . M @GLAZDI C=DIC | |
100 | . . . . . K @GLAZCH M@(FILENUM ) | |
101 | . . . . . ; populat e new list | |
102 | . . . . . F I=1:1 Q :$G(VALLIS T(I))="" D | |
103 | . . . . . . S VAL=V ALLIST(I) S:$E(VAL,* )'="Z" VAL =VAL_"Z" | |
104 | . . . . . . S @GLAZ CHM@(FILEN UM,I,0)=VA L | |
105 | . . . . . . S @GLAZ CHM@(FILEN UM,"B",VAL ,I)="" | |
106 | . . . . . S @GLAZCH M@(FILENUM ,0)=FILENA M_U_FILENU M_U_(I-1)_ U_(I-1) | |
107 | . . . . ; S NZ=$P(NZ ,"$n999")_ "$n"_NNIEN | |
108 | . . . . ; S AI(EIEN, 1)=NZ | |
109 | . . . . ; add the F OUNDIN (or not found in) to TA I | |
110 | . . . . S TAI($I(TE IEN),1)="$ v"_ORV_"^$ n"_$P(TR," ^")_"^$o8^ $n"_MATCHL | |
111 | . . . . S TAI(TEIEN )=TEIEN | |
112 | . . . . S TR=0,EIEN =EIEN2 | |
113 | . . . ; n ot big eno ugh for li st. set E LTYP to 2 to at leas t ICD10 re mediate | |
114 | . . . S E LTYP=2 | |
115 | . . I ELT YP=2 D Q | |
116 | . . . ;M TAI($I(TEI EN))=AI(EI EN) S TAI( TEIEN,0)=T EIEN | |
117 | . . . ;K VALLIST S LISTCNT=$$ EXICD9(NIE N,VAL,.VAL LIST) | |
118 | . . . F V IEN=1:1:VA LLIST S TA I($I(TEIEN ),1)="$v"_ $S($G(ORV) :ORV,1:2)_ "^$n"_TR_" ^"_$S(VALL IST(VIEN)? 1.N:VALLIS T(VIEN),1: """"_VALLI ST(VIEN)_" """) S ORV =0,TAI(TEI EN)=TEIEN | |
119 | . . . S:( EIEN1-1)'= TEIEN STAT US=$S($G(S TATUS)["MA TCHED":STA TUS,$G(STA TUS)["NEW LIST":STAT US,1:"EXPA ND ICD") S EIEN=EIEN 1-1 | |
120 | . S F=0 F I=1:1 S F =$G(AI(I,1 ))_$G(TAI( I,1)) Q:$G (AI(I,1))= ""&($G(TAI (I,1))="") Q:$TR($G (AI(I,1)), """")'=$TR ($G(TAI(I, 1)),"""") | |
121 | . ;I F="" W " Rule #",RIEN," of test " ,AIEN,"(", $P(@GLAZDI C@(741100, AIEN,0),"^ "),") is s ame" | |
122 | . I F'="" D | |
123 | . . ;I PR EFIX'="" W !,PREFIX, "(",$P(@GL AZDIC@(741 100,AIEN,0 ),"^"),") changed" | |
124 | . . M EXP AN(AIEN,RI EN,"AI")=A I,EXPAN(AI EN,RIEN,"T AI")=TAI | |
125 | . . S EXP AN(AIEN,RI EN,4)="" | |
126 | . . ;F I= 1:1 Q:'$D( AI(I,1)) W !,"AI(", I,",1)=",A I(I,1) | |
127 | . . ;W ! | |
128 | . . ;F I= 1:1 Q:'$D( TAI(I,1)) W !,"TAI( ",I,",1)=" ,TAI(I,1) | |
129 | . . S A=0 F S A=$O (@GLAZDIC@ (741100,AI EN,100,RIE N,100,A)) Q:A="" D | |
130 | . . . K @ GLAZDIC@(7 41100,AIEN ,100,RIEN, 100,A) | |
131 | . . S A=0 F S A=$O (TAI(A)) Q :A="" D | |
132 | . . . M @ GLAZDIC@(7 41100,AIEN ,100,RIEN, 100,A)=TAI (A) | |
133 | . I STATU S'="AS-IS" W:WHEAD'= "" !,WHEAD ,! W "Rule ",RIEN,"( ",STATUS," ) " S WHEA D="" | |
134 | I $D(STAT USD) F I=1 :1:STATUSD W !," ",STATUSD( I) | |
135 | Q | |
136 | /* | |
137 | ONEAIX ; | |
138 | S U="^" | |
139 | I $G(ACTI VE(AIEN))' =1 Q | |
140 | W !,AIEN, " ",$P(@GL AZDIC@(741 100,AIEN,0 ),"^"),! | |
141 | ;S TESTTY PE="" | |
142 | S RIEN=0, TTR=0 | |
143 | S MAX=999 ; max num ber of cod es we are not replac ing with l ist | |
144 | F S RIEN =$O(@GLAZD IC@(741100 ,AIEN,100, RIEN)) Q:' RIEN D | |
145 | . S STATU S="AS-IS" | |
146 | . K AI M AI=@GLAZDI C@(741100, AIEN,100,R IEN,100) | |
147 | . K NOUN, TAI,ICD10L S TEIEN=0 | |
148 | . ; check if any of the affec ted nouns are presen t and make list | |
149 | . S TR=0, ELTYP=1 | |
150 | . F EIEN= 1:1 Q:'$D( AI(EIEN)) D | |
151 | . . ; cla ssify elem ent as (1) as is, (2 ) ICD10 or (3) new l ist | |
152 | . . S NIE N="" F NIE NZ=15,19,4 7,74,281 D | |
153 | . . . Q:' $F(AI(EIEN ,1),"$n"_N IEN_"^$o") | |
154 | . . . S N IEN=NIENZ | |
155 | . . . S O PER=+$P(AI (EIEN,1)," $o",2),VAL =$TR($P(AI (EIEN,1)," ^$o"_OPER_ "^",2),""" ") | |
156 | . . . ; f ound in/no t found in (remediat e list) | |
157 | . . . I O PER=8!(OPE R=9) D Q | |
158 | . . . . K VALLIST S LISTIEN=$ P(VAL,"n", 2),L1=0 | |
159 | . . . . S LISTGL="^ "_$P(@GLAZ DIC@(74110 0.01,LISTI EN,1),"^", 6) ;,EXPAN DING=" exp anding lis t " | |
160 | . . . . F S L1=$O( @(LISTGL_" L1)")) Q:' L1 D | |
161 | . . . . . S ICD9=@( LISTGL_"L1 ,0)") | |
162 | . . . . . S LISTCNT =$$EXICD9( NIEN,ICD9, .VALLIST,L ISTGL_"""B "")") | |
163 | . . . . . I LISTCNT >1 S STATU S="LIST EX PANDED" | |
164 | . . . . . ;I LISTCN T>1 S EXPA N(AIEN,RIE N,1)=@GLAZ DIC@(74110 0.01,LISTI EN,0) I EX PANDING'=" " W !,PREF IX,EXPANDI NG,LISTIEN ," ",$P(@G LAZDIC@(74 1100.01,LI STIEN,0)," ^",3) S EX PANDING="" ,PREFIX="" | |
165 | . . . . . ;W !,"ICD 9=",ICD9," LISTCNT= ",LISTCNT | |
166 | . . . . S L1=0 | |
167 | . . . . F S L1=$O( @(LISTGL_" L1)")) Q:L 1="" K @( LISTGL_"L1 )") | |
168 | . . . . F L1=1:1:VA LLIST S @( LISTGL_"L1 ,0)")=VALL IST(L1) S @(LISTGL_" ""B"",VALL IST(L1),L1 )")="" | |
169 | . . . . S $P(@(LIST GL_"0)")," ^",3,4)=VA LLIST_"^"_ VALLIST | |
170 | . . . ; L T, GT, NLT , NGT (<, >, !<, !>) | |
171 | . . . I O PER=2!(OPE R=3)!(OPER =6)!(OPER= 7) Q | |
172 | . . . ; E Q, NEQ | |
173 | . . . I O PER'=1,OPE R'=5 W 1/0 | |
174 | . . . ; n ot as is, so check i f part of ongoing li st or not | |
175 | . . . ;S ELTYP=2 | |
176 | . . . ; n o ongoing list so po tentially start one | |
177 | . . . I ' TR S TR=NI EN_"^$o"_O PER S ELTY P=3,ORV=+$ P(AI(EIEN, 1),"$v",2) Q | |
178 | . . . ;I TR=(NIEN_" ^$o"_OPER) W "." S T RCNT=TRCNT +1,NEWLIST (RIEN,$I(N EWLIST(RIE N)))=VAL,A TOL=1 | |
179 | . . ; if as is just copy elem ent across | |
180 | . . I ELT YP=1 M TAI ($I(TEIEN) )=AI(EIEN) S TAI(TEI EN,0)=TEIE N Q | |
181 | . . ; if element is potential ly part of new list, then ... | |
182 | . . I ELT YP=3 D Q: ELTYP=3 | |
183 | . . . K V ALLIST | |
184 | . . . S L ISTCNT=$$E XICD9(NIEN ,VAL,.VALL IST) | |
185 | . . . S E IEN1=EIEN, EIEN2=EIEN | |
186 | . . . F S EIEN1=$O (AI(EIEN1) ) Q:'EIEN1 Q:'$F(AI (EIEN1,1), "$n"_TR) S EIEN2=EI EN1,XX=$$E XICD9(NIEN ,$TR($P(AI (EIEN1,1), "^$o"_OPER _"^",2),"" ""),.VALLI ST),LISTCN T=LISTCNT+ XX | |
187 | . . . S G LAZZ=1 | |
188 | . . . I L ISTCNT>MAX D Q | |
189 | . . . . ; commit to list | |
190 | . . . . ; check if this list exists and can be ma tched on C RC | |
191 | . . . . S LIEN=7411 00,MATCH=0 ,NEWCRC=0, MATCHL=0 | |
192 | . . . . F I=1:1:VAL LIST S NEW CRC=NEWCRC +$ZCRC(VAL LIST(I),7) | |
193 | . . . . F S LIEN=$ O(@GLAZDIC @(LIEN)) Q :'LIEN D Q:MATCH | |
194 | . . . . . I $G(@GLA ZDIC@(LIEN ,0))'["AIF D" Q | |
195 | . . . . . ;W !,"Att empting to match ",L IEN," ",@G LAZDIC@(LI EN,0)," ", $$LISTCRC( LIEN)," ", NEWCRC | |
196 | . . . . . I $$LISTC RC(LIEN)=N EWCRC S MA TCH=LIEN Q | |
197 | . . . . I MATCH D | |
198 | . . . . . S I=0 | |
199 | . . . . . F S I=$O (@GLAZDIC@ (741100.01 ,I)) Q:'I I $G(@GLA ZDIC@(7411 00.01,I,1) )[("CHMDIC ("_LIEN_", ") S MATCH L=I Q | |
200 | . . . . I MATCHL S EXPAN(AIEN ,RIEN,3)=$ G(@GLAZDIC @(741100.0 1,MATCHL,0 )) S STATU S="MATCHED "_MATCHL ;W !,PREFI X," reuse matched li st ",MATCH L," ",$P(E XPAN(AIEN, RIEN,3),"^ ",3) S PRE FIX="" | |
201 | . . . . ; make new list | |
202 | . . . . I 'MATCHL D | |
203 | . . . . . S FILENUM =741112.04 _AIEN_RIEN | |
204 | . . . . . ;S FILENA M="CHAMPVA AIFD CONV ERSION LIS T "_AIEN_" "_RIEN | |
205 | . . . . . ;S NOUNNA M="CONVERS ION TEST " _AIEN_" "_ RIEN | |
206 | . . . . . S FILENAM ="CHAMPVA AIFD CONVE RSION LIST "_$P(@GLA ZDIC@(7411 00,AIEN,0) ,U)_" "_RI EN | |
207 | . . . . . S NOUNNAM ="CONVERSI ON FOR "_$ P(@GLAZDIC @(741100,A IEN,0),U)_ " "_RIEN | |
208 | . . . . . S MATCHL= $$MKNNEW(F ILENUM,FIL ENAM,NOUNN AM) | |
209 | . . . . . S EXPAN(A IEN,RIEN,2 )=$G(DIC(7 41100.01,M ATCHL,0)) | |
210 | . . . . . ;w !,PREF IX," made new list " ,MATCHL," ",$P(EXPAN (AIEN,RIEN ,2),"^",3) S PREFIX= "" | |
211 | . . . . . S STATUS= "NEW LIST "_MATCHL | |
212 | . . . . . M @GLAZDD =DD | |
213 | . . . . . M @GLAZDI C=DIC | |
214 | . . . . . ; populat e new list | |
215 | . . . . . F I=1:1 Q :$G(VALLIS T(I))="" D | |
216 | . . . . . . S VAL=V ALLIST(I) S:$E(VAL,* )'="Z" VAL =VAL_"Z" | |
217 | . . . . . . S @GLAZ CHM@(FILEN UM,I,0)=VA L | |
218 | . . . . . . S @GLAZ CHM@(FILEN UM,"B",VAL ,I)="" | |
219 | . . . . . S @GLAZCH M@(FILENUM ,0)=FILENA M_U_FILENU M_U_(I-1)_ U_(I-1) | |
220 | . . . . ; S NZ=$P(NZ ,"$n999")_ "$n"_NNIEN | |
221 | . . . . ; S AI(EIEN, 1)=NZ | |
222 | . . . . ; add the F OUNDIN (or not found in) to TA I | |
223 | . . . . S TAI($I(TE IEN),1)="$ v"_ORV_"^$ n"_$P(TR," ^")_"^$o8^ $n"_MATCHL | |
224 | . . . . S TAI(TEIEN )=TEIEN | |
225 | . . . . S TR=0,EIEN =EIEN2 | |
226 | . . . ; n ot big eno ugh for li st. set E LTYP to 2 to at leas t ICD10 re mediate | |
227 | . . . S E LTYP=2 | |
228 | . . I ELT YP=2 D Q | |
229 | . . . ;M TAI($I(TEI EN))=AI(EI EN) S TAI( TEIEN,0)=T EIEN | |
230 | . . . K V ALLIST S L ISTCNT=$$E XICD9(NIEN ,VAL,.VALL IST) | |
231 | . . . F V IEN=1:1:LI STCNT S TA I($I(TEIEN ),1)="$v"_ $S($G(ORV) :ORV,1:2)_ "^$n"_TR_" ^"_$S(VALL IST(VIEN)? 1.N:VALLIS T(VIEN),1: """"_VALLI ST(VIEN)_" """) S ORV =0,TAI(TEI EN)=TEIEN | |
232 | . S F=0 F I=1:1 S F =$G(AI(I,1 ))_$G(TAI( I,1)) Q:$G (AI(I,1))= ""&($G(TAI (I,1))="") Q:$TR($G (AI(I,1)), """")'=$TR ($G(TAI(I, 1)),"""") | |
233 | . ;I F="" W " Rule #",RIEN," of test " ,AIEN,"(", $P(@GLAZDI C@(741100, AIEN,0),"^ "),") is s ame" | |
234 | . I F'="" D | |
235 | . . ;I PR EFIX'="" W !,PREFIX, "(",$P(@GL AZDIC@(741 100,AIEN,0 ),"^"),") changed" | |
236 | . . M EXP AN(AIEN,RI EN,"AI")=A I,EXPAN(AI EN,RIEN,"T AI")=TAI | |
237 | . . S EXP AN(AIEN,RI EN,4)="" | |
238 | . . ;F I= 1:1 Q:'$D( AI(I,1)) W !,"AI(", I,",1)=",A I(I,1) | |
239 | . . ;W ! | |
240 | . . ;F I= 1:1 Q:'$D( TAI(I,1)) W !,"TAI( ",I,",1)=" ,TAI(I,1) | |
241 | . . S A=0 F S A=$O (@GLAZDIC@ (741100,AI EN,100,RIE N,100,A)) Q:A="" D | |
242 | . . . K @ GLAZDIC@(7 41100,AIEN ,100,RIEN, 100,A) | |
243 | . . . M @ GLAZDIC@(7 41100,AIEN ,100,RIEN, 100,A)=TAI (A) | |
244 | . W "Rule ",RIEN,"( ",STATUS," ) " | |
245 | Q | |
246 | ; | |
247 | */ | |
248 | WEXPAN ; | |
249 | S AIEN=0 | |
250 | F S AIEN =$O(EXPAN( AIEN)) Q:A IEN="" D | |
251 | . S RIEN= "" | |
252 | . F S RI EN=$O(EXPA N(AIEN,RIE N)) Q:RIEN ="" D | |
253 | . . I $D( EXPAN(AIEN ,RIEN,1)) D | |
254 | . . . W ! ,"Rule #", RIEN," of test ",AIE N,"(",$P(@ GLAZDIC@(7 41100,AIEN ,0),"^")," )" | |
255 | . . . W " expanded list ",$P( EXPAN(AIEN ,RIEN,1)," ^") | |
256 | . . I $D( EXPAN(AIEN ,RIEN,2)) D | |
257 | . . . W ! ,"Rule #", RIEN," of test ",AIE N,"(",$P(@ GLAZDIC@(7 41100,AIEN ,0),"^")," )" | |
258 | . . . W " created l ist ",$P(E XPAN(AIEN, RIEN,2),"^ ") | |
259 | . . I $D( EXPAN(AIEN ,RIEN,3)) D | |
260 | . . . W ! ,"Rule #", RIEN," of test ",AIE N,"(",$P(@ GLAZDIC@(7 41100,AIEN ,0),"^")," )" | |
261 | . . . W " reused li st ",$P(EX PAN(AIEN,R IEN,3),"^" ) | |
262 | . . I $O( EXPAN(AIEN ,RIEN,"")) =4 D | |
263 | . . . W ! ,"Rule #", RIEN," of test ",AIE N,"(",$P(@ GLAZDIC@(7 41100,AIEN ,0),"^")," )" | |
264 | . . . W " in-test e xpanded co de list" | |
265 | Q | |
266 | ; Write t est elemen t with val ue NZ | |
267 | WRTELEM(AI EN,RIEN,EI EN,NZ) ; | |
268 | ;W !,AIEN ,"~",RIEN, "~",EIEN," ~",NZ | |
269 | ;S X=NZ,F L="A" D AI 4^CHMGDTS W "~",Y | |
270 | ;S X=NZ,F L="F" D AI 4^CHMGDTS W "~",Y | |
271 | ;W !,AIEN ,",",RIEN, ",",EIEN,? 20 | |
272 | D WL,WS,W S S X=NZ,F L="F" D AI 4 D:EIEN>1 WS,WS W Y | |
273 | Q | |
274 | ; Web wri te line | |
275 | WL ; | |
276 | I $d(%req uest) w "< /BR>" W ! | |
277 | E W ! | |
278 | Q | |
279 | ; web wri te space | |
280 | WS I $d(%r equest) w " " | |
281 | E W " " | |
282 | Q | |
283 | ; ai conv ersion - m ake new no un | |
284 | MKNNEW(FIL ENUM,FILEN AM,NOUNNAM E) | |
285 | K DD,DIC, INFO | |
286 | D NINFO($ P($P($G(@G LAZDIC@(74 1100,AIEN, 0)),"^")," #",2),RIEN ,.INFO) | |
287 | ;I '$D(IN FO) W 1/0 | |
288 | I $D(INFO ("SHORT")) S FILENAM ="CHAMPVA AIFD "_INF O("SHORT") | |
289 | ; | |
290 | ; If we a re creatin g Noun PHL EBOTOMY_DI AGNOSIS_AC CEPT, rena me existin g one | |
291 | ; to UNUS ED_PHLEBOT OMY_DIAGNO SIS_ACCEPT | |
292 | I $G(INFO ("FULL"))= "PHLEBOTOM Y_DIAGNOSI S_ACCEPT" D | |
293 | . S OPDAI EN=$O(@GLA ZDIC@(7411 00.01,"B", INFO("FULL "),"")) | |
294 | . Q:'OPDA IEN | |
295 | . K @GLAZ DIC@(74110 0.01,"B",I NFO("FULL" ),OPDAIEN) | |
296 | . S OPDAN N=$P(@GLAZ DIC@(74110 0.01,OPDAI EN,0),"^") | |
297 | . S OPDAF D=$P(@GLAZ DIC@(74110 0.01,OPDAI EN,0),"^", 3) | |
298 | . S $P(@G LAZDIC@(74 1100.01,OP DAIEN,0)," ^")="UNUSE D_"_OPDANN | |
299 | . S $P(@G LAZDIC@(74 1100.01,OP DAIEN,0)," ^",3)="UNU SED_"_OPDA FD | |
300 | . S @GLAZ DIC@(74110 0.01,"B"," UNUSED_"_O PDANN,OPDA IEN)=1 | |
301 | . S @GLAZ DIC@(74110 0.01,"B"," UNUSED_"_O PDAFD,OPDA IEN)=1 | |
302 | ; make DD | |
303 | S DD(FILE NUM,0)="FI ELD^^.01^1 " | |
304 | S DD(FILE NUM,0,"DT" )=3040217 | |
305 | S DD(FILE NUM,0,"IX" ,"B",FILEN UM,.01)="" | |
306 | S DD(FILE NUM,0,"NM" ,FILENAM)= "" | |
307 | S DD(FILE NUM,.01,0) ="PROCEDUR E/DIAGNOSI S/NDC CODE ^RF^^0;1^K :$L(X)>15! ($L(X)<1)! '(X'?1P.E) X" | |
308 | S DD(FILE NUM,.01,1, 0)="^.1" | |
309 | S DD(FILE NUM,.01,1, 1,0)=FILEN UM_"^B" | |
310 | S DD(FILE NUM,.01,1, 1,1)="S ^C HMDIC("_FI LENUM_","" B"",$E(X,1 ,30),DA)=" """" | |
311 | S DD(F ILENUM,.01 ,1,1,2)="K ^CHMDIC(" _FILENUM_" ,""B"",$E( X,1,30),DA )" | |
312 | S DD(FILE NUM,.01,3) ="Answer m ust be 1-1 5 characte rs in leng th." | |
313 | S DD(F ILENUM,.01 ,"DT")=304 0217 | |
314 | S DD(FILE NUM,"B","P ROCEDURE/D IAGNOSIS/N DC CODE",. 01)="" | |
315 | S DD(FILE NUM,"GL",0 ,1,.01)="" | |
316 | S DD(FILE NUM,"IX",. 01)="" | |
317 | S DD(FILE NUM,"RQ",. 01)="" | |
318 | ; make DI C | |
319 | S DIC(FIL ENUM,0)=FI LENAM_"^"_ FILENUM | |
320 | S DIC(FIL ENUM,0,"AU DIT")="@" | |
321 | S DIC( FILENUM,0, "DD")="@" | |
322 | S DIC( FILENUM,0, "DEL")="@" | |
323 | S DIC( FILENUM,0, "GL")="^CH MDIC("_FIL ENUM_"," | |
324 | S DIC( FILENUM,0, "LAYGO")=" @" | |
325 | S DIC( FILENUM,0, "RD")="@" | |
326 | S DIC( FILENUM,0, "WR")="@" | |
327 | S DIC(FIL ENUM,0,"%A ")="0^3040 217" | |
328 | S DIC("B" ,FILENAM,F ILENUM)="" | |
329 | ; make ne w AI noun | |
330 | S NNIEN=$ O(@GLAZDIC @(741100.0 1," "),-1) +1 | |
331 | S DIC(741 100.01,0)= @GLAZDIC@( 741100.01, 0) | |
332 | S $P(DIC( 741100.01, 0),U,3)=NN IEN,$P(DIC (741100.01 ,0),U,4)=$ P(DIC(7411 00.01,0),U ,4)+1 | |
333 | S DIC(741 100.01,NNI EN,0)=NOUN NAME_U_NOU NNAME_U_NO UNNAME | |
334 | I $D(INFO ("NOUN")) S $P(DIC(7 41100.01,N NIEN,0),U) =INFO("NOU N") | |
335 | I $D(INFO ("SHORT")) S $P(DIC( 741100.01, NNIEN,0),U ,2)=INFO(" SHORT") | |
336 | I $D(INFO ("FULL")) S $P(DIC(7 41100.01,N NIEN,0),U, 3)=INFO("F ULL") | |
337 | S DIC( 741100.01, NNIEN,1)=" F^^^^1^CHM DIC("_FILE NUM_"," | |
338 | I $D(INFO ),$TR($G(I NFO("SYN") )," ","")' ="" D | |
339 | . S DIC(7 41100.01,N NIEN,100,0 )="^741100 .011^1^1" | |
340 | . S DIC(7 41100.01,N NIEN,100,1 ,0)=INFO(" SYN") | |
341 | . S DIC(7 41100.01,N NIEN,100," B",INFO("S YN"),1)="" | |
342 | S DIC(741 100.01,"B" ,$P(DIC(74 1100.01,NN IEN,0),U), NNIEN)="" | |
343 | ; descrip tion | |
344 | I $D(INFO ("DESC")) S DIC(7411 00.01,NNIE N,101,1,0) =INFO("DES C"),I=-1 | |
345 | E D | |
346 | . S DIC(7 41100.01,N NIEN,101,1 ,0)="Sourc e Test: "_ AIEN_" ("_ $TR($P($G( @GLAZDIC@( 741100,AIE N,0)),U,1, 2),U,"/")_ ")" | |
347 | . S DIC(7 41100.01,N NIEN,101,2 ,0)="Sourc e Rule: "_ RIEN_" ("_ $G(@GLAZDI C@(741100, AIEN,100,R IEN,0))_") " | |
348 | . S DIC(7 41100.01,N NIEN,101,3 ,0)="" | |
349 | . F I=1:1 Q:'$D(@GL AZDIC@(741 100,AIEN,1 01,I)) S DIC(741100 .01,NNIEN, 101,I+3,0) =@GLAZDIC@ (741100,AI EN,101,I,0 ) | |
350 | S DIC(741 100.01,NNI EN,101,0)= "^741100.0 12^"_(I+2) _U_(I+2) | |
351 | Q NNIEN | |
352 | ; expand ICD9 code for NIEN ( need that to see if DX/PCS/oth ers) | |
353 | EXICD9(NIE N,ICD9,RET ,XREF) ; | |
354 | ;W !,NIEN ," ",ICD9 | |
355 | S OICD9=I CD9 | |
356 | I $E(ICD9 ,*)="Z" S ICD9=$E(IC D9,1,*-1) | |
357 | S ICD9=$T R(ICD9,"." ) | |
358 | S RET($I( RET))=OICD 9 | |
359 | S REPL=1 | |
360 | ; 120 is neither so we just g et 1 | |
361 | I NIEN=12 0 G EXICD9 X | |
362 | ; 19,263 are the on ly DX | |
363 | I NIEN=19 !(NIEN=263 ) D | |
364 | . ;W !,AI (EIEN,1),! | |
365 | . S ICD10 IEN=0 | |
366 | . ; 10 to 9 transla tion file | |
367 | . F S IC D10IEN=$O( ^CHIVM(741 033.7,"AB" ,$TR(ICD9, "."),ICD10 IEN)) Q:'I CD10IEN D | |
368 | . . Q:$P( ^CHIVM(741 033.7,ICD1 0IEN,0),"^ ",2)'="CM" | |
369 | . . S ICD 10=$P(^CHI VM(741033. 7,ICD10IEN ,0),"^") | |
370 | . . I OIC D9?.E1"Z" S ICD10=IC D10_"Z" | |
371 | . . I $D( ICD10L(ICD 10)) Q | |
372 | . . I $G( XREF)'="", $D(@XREF@( ICD10)) Q | |
373 | . . S RET ($I(RET))= ICD10,ICD1 0L(ICD10)= 1,REPL=REP L+1 | |
374 | . ; 9 to 10 transla tion file | |
375 | . S ICD9I EN="" | |
376 | . F S IC D9IEN=$O(^ CHMDIC(741 033.5,"B", OICD9,ICD9 IEN)) Q:'I CD9IEN Q: $P(^CHMDIC (741033.5, ICD9IEN,0) ,"^",2)="C M" | |
377 | . Q:'ICD9 IEN | |
378 | . S ICD10 XI=0 F S ICD10XI=$O (^CHMDIC(7 41033.5,IC D9IEN,3,IC D10XI)) Q: 'ICD10XI D | |
379 | . . S ICD 10=^CHMDIC (741033.5, ICD9IEN,3, ICD10XI,0) | |
380 | . . I $L( ICD10)>3 S ICD10=$E( ICD10,1,3) _"."_$E(IC D10,4,*) | |
381 | . . I $D( ICD10L(ICD 10))!$D(IC D10L(ICD10 _"Z")) Q | |
382 | . . I $G( XREF)'="", $D(@XREF@( ICD10))!$D (@XREF@(IC D10_"Z")) Q | |
383 | . . S RET ($I(RET))= ICD10,ICD1 0L(ICD10)= 1,REPL=REP L+1 | |
384 | ; NIEN be sides 19,2 63 and 120 are servi ces | |
385 | I NIEN'=1 9,NIEN'=26 3 D | |
386 | . S ICD9I EN="" | |
387 | . F S IC D9IEN=$O(^ CHMSERV("B ",ICD9,ICD 9IEN)) Q:' ICD9IEN Q :$P($G(^CH MSERV(ICD9 IEN,0)),"^ ",5)="ICD- 9" | |
388 | . Q:'ICD9 IEN | |
389 | . ; 10 TO 9 | |
390 | . S ICD10 IEN=0 | |
391 | . F S IC D10IEN=$O( ^CHIVM(741 033.7,"AB" ,$TR(ICD9, "."),ICD10 IEN)) Q:'I CD10IEN D | |
392 | . . Q:$P( ^CHIVM(741 033.7,ICD1 0IEN,0),"^ ",2)'="PCS " | |
393 | . . S ICD 10=$P(^CHI VM(741033. 7,ICD10IEN ,0),"^") | |
394 | . . I OIC D9?.E1"Z" S ICD10=IC D10_"Z" | |
395 | . . I $D( ICD10L(ICD 10)) Q | |
396 | . . I $G( XREF)'="", $D(@XREF@( ICD10)) Q | |
397 | . . S RET ($I(RET))= $TR(ICD10, "."),ICD10 L(ICD10)=1 ,REPL=REPL +1 | |
398 | . ; 9 TO 10 | |
399 | . S ICD9I EN="" | |
400 | . F S IC D9IEN=$O(^ CHMDIC(741 033.5,"B", ICD9,"")) Q:'ICD9IEN Q:$P(^CH MDIC(74103 3.5,ICD9IE N,0),"^",2 )="PCS" | |
401 | . Q:'ICD9 IEN | |
402 | . S ICD10 XI=0 F S ICD10XI=$O (^CHMDIC(7 41033.5,IC D9IEN,3,IC D10XI)) Q: 'ICD10XI D | |
403 | . . S ICD 10=^CHMDIC (741033.5, ICD9IEN,3, ICD10XI,0) | |
404 | . . I $D( ICD10L(ICD 10))!$D(IC D10L(ICD10 _"Z")) Q | |
405 | . . I $G( XREF)'="", $D(@XREF@( ICD10))!$D (@XREF@(IC D10_"Z")) Q | |
406 | . . S RET ($I(RET))= $TR(ICD10, "."),ICD10 L(ICD10)=1 ,REPL=REPL +1 | |
407 | EXICD9X ; | |
408 | Q REPL | |
409 | ; scan AI tests for partticul ar noun/ve rb/operati on | |
410 | FIND ; | |
411 | R !,"Find : ",FND S FND="^"_FN D | |
412 | S AIIEN=0 K GLAZ | |
413 | F S AIIE N=$O(^DIC( 741100,AII EN)) Q:'AI IEN D | |
414 | . S DATA= $g(^DIC(74 1100,AIIEN ,1)) I "^" _DATA[FND W !,$ZR," ",DATA," ",$$AID C(DATA) | |
415 | . I DATA' ="" F I=1: 1:$L(DATA, "^") S GLA Z($P(DATA, "^",I),AII EN)=DATA | |
416 | . S RULE= 0 | |
417 | . F S RU LE=$O(^DIC (741100,AI IEN,100,RU LE)) Q:'RU LE D | |
418 | . . S ELE M=0 | |
419 | . . F S ELEM=$O(^D IC(741100, AIIEN,100, RULE,100,E LEM)) Q:'E LEM D | |
420 | . . . S D ATA=^DIC(7 41100,AIIE N,100,RULE ,100,ELEM, 1) ;w !,DA TA | |
421 | . . . F I =1:1:$L(DA TA,"^") S GLAZ($P(DA TA,"^",I), AIIEN)=DAT A | |
422 | . . . I " ^"_DATA_"^ "[FND W !, $ZR," ", DATA," " ,$$AIDC(DA TA) | |
423 | Q | |
424 | ; Printab le version of AI tes t element (used but a bit obso lete. AI 4 is alter native) | |
425 | AIDC(D) ; | |
426 | N I,DP | |
427 | F I=1:1:$ L(D,"^") D | |
428 | . S DP=$P (D,"^",I) | |
429 | . D | |
430 | . . I DP? 1"$v".N S DP=$P("IF, OR,AND,THE N,SET,KILL ,QUIT,PROC EDURE,AITE ST",",",$E (DP,3)) Q | |
431 | . . I DP? 1"$o".N S DP=$P(^DIC (741100.03 ,$E(DP,3), 0),"^") Q | |
432 | . . I DP? 1"$F".N S DP=$P(^DIC (741100.02 ,$E(DP,3,4 ),0),"^") Q | |
433 | . . I DP? 1"$n".E S DP=$P(^DIC (741100.01 ,$E(DP,3,9 ),0),"^") Q | |
434 | . S $P(D, "^",I)=DP | |
435 | Q D | |
436 | ;; lifted from CHMG DTS - disp lay AI ele ment in X. | |
437 | ;; FL is "F" for fu ll, "A" fo r abbrevia ted | |
438 | AI4 S:'$D( FL) FL="F" ;S FL="A" | |
439 | S Y=X F I =1:1 S Z=$ P(Y,"^",I) Q:Z="" D SB11:Z?1" $"1.E | |
440 | S R="^",W =" " D SBR P^CHMGDTS | |
441 | Q | |
442 | SB11 S V=$ E(Z,2) G S 1:V="o",S2 :V="n",S3: V="F",S4:V ="v",SE | |
443 | S1 S V=+$E (Z,3,999) G SE:'V,SE :'$D(@GLAZ DIC@(74110 0.03,V,0)) S W=^(0) G S21 | |
444 | S21 D SB2 S $P(Y,"^" ,I)=T Q | |
445 | S2 S V=+$E (Z,3,999) G SE:'V,SE :'$D(@GLAZ DIC@(74110 0.01,V,0)) S W=^(0) G S22 | |
446 | S22 D SB2 D SBF2 S $ P(Y,"^",I) =T Q | |
447 | S3 S V=+$E (Z,3,999) G SE:'V,SE :'$D(@GLAZ DIC@(74110 0.02,V,0)) S W=^(0) D SB2 | |
448 | S TY="$FU NCTION("_T ,VD=$P(Z," ,",2,999) | |
449 | F K=1:1 S Z=$P(VD," ,",K) Q:Z= "" S T=Z D:Z?1"$n"1 .E S TY=T Y_","_T | |
450 | . S V=+$E (Z,3,999) Q:'V!'$D(@ GLAZDIC@(7 41100.01,V ,0)) S W= ^(0) D SB2 | |
451 | S $P(Y,"^ ",I)=TY_") " Q | |
452 | ;G S9 | |
453 | S4 S V=+$E (Z,3,999) G SE:'V S W=$P($T(VE RB+V),";", 3) G SE:W= "" | |
454 | S $P(Y,"^ ",I)=W | |
455 | G SE | |
456 | S9 ;D SB2 S $P(Y,"^" ,I)=T | |
457 | SE Q | |
458 | SB2 S T=$P (W,"^",FL' ="A"+2) S: T="" T=$P( W,"^",1) | |
459 | Q | |
460 | SBF2 S FDF LAG=0 | |
461 | G SE:'$D( @GLAZDIC@( 741100.01, V,1)) S WW =^(1) | |
462 | I $P(WW," ^",1)="F" S FDFLAG=1 ,FDNAME="^ "_$P(WW,"^ ",6) Q | |
463 | E Q | |
464 | VERB ;; | |
465 | ;;IF | |
466 | ;;OR | |
467 | ;;AND | |
468 | ;;THEN | |
469 | ;;SET | |
470 | ;;KILL | |
471 | ;;QUIT | |
472 | ;;PROCEDU RE | |
473 | ;;AI_TEST | |
474 | ;; | |
475 | ; Evaluat e all noun s and put them into object OBJ | |
476 | ENTRY ; | |
477 | S PASS=1 | |
478 | ENTRY2 ; | |
479 | ;S $ZT="E R0^CHICDAI " ; commen ted out fo r now sinc e we want to see the errors | |
480 | S OBJ=##C LASS(Claim Service.cl aimData).% New() | |
481 | ;S cdef=# #class(%Di ctionary.C lassDefini tion).%Ope nId($P(OBJ ,"@",2)) | |
482 | ;S count= cdef.Prope rties.Coun t() | |
483 | ;F i=1:1: count D | |
484 | ;. S OBJP ROPS(cdef. Properties .GetAt(i). Name)=cdef .Propertie s.GetAt(i) .Collectio n | |
485 | ;. S A=cd ef.Propert ies.GetAt( i).Name | |
486 | ;. I A?1" date".E!(A ["Date") S OBJPROPS( cdef.Prope rties.GetA t(i).Name) ="date" | |
487 | ;D | |
488 | ;. K OBJP ROPS | |
489 | ;. S OBJ. aiTestName =$P(^DIC(A HFILE,AHTS ,0),"^") | |
490 | ;. S O BJ.claimNu mber="9999 " | |
491 | ;. S S ERVICE=##c lass(Claim Service.Cl aimSoap11) .%New() | |
492 | ;. S USER TOKEN=##cl ass(%SOAP. Security.U sernameTok en).Create ("icdjrule user","res 2012") | |
493 | ;. D SERV ICE.Securi tyOut.AddT oken(USERT OKEN) | |
494 | ;. S s c=SERVICE. claim(OBJ, .RESPONSE) | |
495 | ;. F M L=1:1:RESP ONSE.messa geList.Cou nt() D | |
496 | ;. . S PN=RESPON SE.message List.GetAt (ML).key,O K=0 | |
497 | ;. . F ML2=1:1:c def.Proper ties.Count () D Q:OK | |
498 | ;. . . I cdef.Pr operties.G etAt(ML2). Name=PN D | |
499 | ;. . . . S OBJPR OPS(PN)=cd ef.Propert ies.GetAt( i).Collect ion,OK=1 | |
500 | ;. . . . I PN?1" date".E!(P N["Date") S OBJPROPS (cdef.Prop erties.Get At(i).Name )="date" | |
501 | S (AHSTV,AHE RV,AHRTE,A HQUIT,AHCT C)="",U="^ " | |
502 | G END:'$D (AHFILE),E ND:'AHFILE ,END:'$D(A HTS) | |
503 | G END:'$D (^DIC(AHFI LE,AHTS,0) ) S AHTSX= ^(0) | |
504 | S Y=+$P(A HTSX,U,4) G END:'Y S AHOPDIC=Y | |
505 | S Y=+$P(A HTSX,U,5) G END:'Y S AHNODIC=Y | |
506 | S Y=+$P(A HTSX,U,6) G END:'Y S AHFNDIC=Y | |
507 | S Y=+$P(A HTSX,U,7) G END:'Y S AHPRDIC=Y | |
508 | K OBJPROP S | |
509 | S I=0 F S I=$O(^DI C(AHFILE,A HTS,102,I) ) Q:'I S DATA=^(I,0 ),OBJPROPS ($P(DATA,U ))=$P(DATA ,U,2) | |
510 | ; Backgro und tests | |
511 | ;F I="ccA geConflict Result","c cAsstSurge onResult", "ccCosmetU nlsResult" S OBJPROP S(I)="" | |
512 | ;F I="ccE xperimenta lResult"," ccLineOrig ination"," ccObsolete ProcResult " S OBJPRO PS(I)="" | |
513 | ;F I="ccR esult","cc SexConflic tResult"," rebundleCo dePresent" S OBJPROP S(I)="" | |
514 | ;S OBJ.AI TestNumber =AHTS | |
515 | S OBJ.aiT estName=$P (AHTSX,U) | |
516 | S OBJ.cla imNumber=$ G(CN) | |
517 | S AHRTE=+ $O(^DIC(AH NODIC,"B", "ROUTE",0) ) | |
518 | S AHSTV=+ $O(^DIC(AH NODIC,"B", "STATUS",0 )) | |
519 | S AHCTC=+ $O(^DIC(AH NODIC,"B", "CTC",0)) | |
520 | S AHQUIT= +$O(^DIC(A HNODIC,"B" ,"QUIT",0) ) | |
521 | S AHDATA( AHQUIT,1)= $P(^DIC(AH NODIC,AHQU IT,1),"^", 2),V=AHQUI T D XREFN( V) | |
522 | S X=$O(^D IC(AHNODIC ,"B","ERRO R",0)) | |
523 | I X,$D(^D IC(AHNODIC ,X,1)) S A HERV=$P(^( 1),U,2) | |
524 | I AHSTV,A HERV K AHD ATA(AHSTV) S AHDATA( AHSTV,1)=A HERV,V=AHS TV | |
525 | ; Compile list of a ll needed variables. | |
526 | ; backgro und AI tas ks | |
527 | I $D(^DIC (AHFILE,AH TS,2)),^(2 )'="",'$D( AHTSBG) X ^(2) G:AHD ATA(AHQUIT ,1)=1 END3 | |
528 | ; Compile list of a ll needed AI nouns. | |
529 | K AINOUNS | |
530 | ; Derivin g list of nouns from the AI te st definit on in Cach e is obsol ete. Inst ead | |
531 | ; we will be using 102 area, obtain fro m Jrules. | |
532 | ;S J=0 | |
533 | ;F S J=$ O(^DIC(AHF ILE,AHTS,1 00,J)) Q:' J D | |
534 | ;. S K=0 | |
535 | ;. F S K =$O(^DIC(A HFILE,AHTS ,100,J,100 ,K)) Q:'K D | |
536 | ;. . S V= ^DIC(AHFIL E,AHTS,100 ,J,100,K,1 ) | |
537 | ;. . F L= 1:1:$L(V,U ) I $P(V,U ,L)?1"$n"1 .N S AINOU NS($P($P(V ,U,L),"n", 2))=1 | |
538 | ; also ad d all noun s that cam e from bac kground ta sks | |
539 | ;;S A="" F S A=$O( AHDATA(A)) Q:'A S A INOUNS(A)= 0 | |
540 | ; | |
541 | ; this is if we wan t to popul ate all no uns define d in reque st object. | |
542 | ; Since w e are filt ering by O BJPROPS, t his is fin e | |
543 | S A=0 F S A=$O(^DI C(AHNODIC, A)) Q:'A D | |
544 | . S NZ=$$ PAR($P($G( ^DIC(AHNOD IC,A,0)),U ,3)) I NZ' ="",$D(OBJ PROPS(NZ)) S AINOUNS (A)=2 | |
545 | ; | |
546 | S:'$D(AHD T) AHDT=DT S:AHDT'?7 N AHDT=DT | |
547 | S:'$D(AHR T) AHRT="T " S AHRT=$ E(AHRT,1) S:"TBI"'[A HRT AHRT=" T" | |
548 | S A=+$P(A HTSX,U,10) ,B=+$P(AHT SX,U,11) S :'A A=AHDT S:'B B=AH DT | |
549 | I (AHDT<A )!(AHDT>B) G END2 | |
550 | ; default outcome. All of th em are SET STATUS EQ UALS XXX s o do that | |
551 | I $D(^DIC (AHFILE,AH TS,1)) S A HEX=^(1) I AHEX?1"$v 5^".E S AH DF=$E($P(A HEX,"^",4) ,3,99) D N EVAL("$n"_ AHDF,"",$$ PAR($P(^DI C(AHNODIC, AHDF,0),U, 3))) S AHD ATA(AHSTV, 1)=AHDATA( AHDF,1) | |
552 | ; flat all n oun evalua tion | |
553 | D NEVAL("$F1 2",OBJ,"qu alityAssur anceCheck" ) | |
554 | S NIEN=0 | |
555 | F S NIEN =$O(AINOUN S(NIEN)) Q :'NIEN D | |
556 | . S NZ=$$PAR ($P($G(^DI C(AHNODIC, NIEN,0)),U ,3)) Q:NZ= "" | |
557 | . I '$D(OBJP ROPS(NZ)) Q | |
558 | . D NEVAL("$ n"_NIEN,OB J,NZ) Q | |
559 | ; create pla ceholder R ESULT OF Q A REVIEW i f not ther e. | |
560 | S RST=+$O(^D IC(AHNODIC ,"B","REVI EW",0)) | |
561 | I $G(AHDATA( RST,1))="" S AHDATA( RST,1)=0 D XREFN(RST ) S OBJ.re sultOfQaRe view=0 | |
562 | ; run the ca ll to remo te system | |
563 | S SERVICE =##class(C laimServic e.ClaimSoa p11).%New( ) | |
564 | S USERTOK EN=##class (%SOAP.Sec urity.User nameToken) .Create("i cdjruleuse r","res201 2") | |
565 | D SERVICE .SecurityO ut.AddToke n(USERTOKE N) | |
566 | S ZH=$ZH, RESULT="" | |
567 | S AISTATU S=SERVICE. claim(OBJ, .RESULT) | |
568 | ; Check i f RESULT w ants to re populate t he NOUN PR OPERTIES m ultiple | |
569 | S MD=0 | |
570 | I RESULT. messageLis t.Count() D G:MD EN TRY2:PASS< 3 | |
571 | . S cdef= ##class(%D ictionary. ClassDefin ition).%Op enId($P(OB J,"@",2)) | |
572 | . F ML =1:1:RESUL T.messageL ist.Count( ) D | |
573 | . . S PN=RESULT. messageLis t.GetAt(ML ).key,OK=0 | |
574 | . . I RESULT.mes sageList.G etAt(ML).v alue'["is missing" Q | |
575 | . . F ML2=1:1:cd ef.Propert ies.Count( ) D Q:OK | |
576 | . . . I cdef.Pro perties.Ge tAt(ML2).N ame=PN D | |
577 | . . . . S OK=1,M D=1,PASS=$ G(PASS)+1 | |
578 | . . . . S NZ=$G( ^DIC(AHFIL E,AHTS,102 ,0)) S:NZ= "" NZ="^74 1100.004^0 ^0" | |
579 | . . . . S $P(NZ, U,3)=$P(NZ ,U,3)+1,$P (NZ,U,4)=$ P(NZ,U,4)+ 1 S ^DIC(A HFILE,AHTS ,102,0)=NZ | |
580 | . . . . S ^DIC(A HFILE,AHTS ,102,"B",P N,$P(NZ,U, 3))="" | |
581 | . . . . S ^DIC(A HFILE,AHTS ,102,$P(NZ ,U,3),0)=P N_$S(PN?1" date".E:"d ate",PN["D ate":"date ",1:cdef.P roperties. GetAt(ML2) .Collectio n) | |
582 | I AISTATU S="ERROR" G ER0 | |
583 | S sTv("SE RVICE")=$Z H-ZH | |
584 | I '$ISOBJ ECT(RESULT ) G ER0 | |
585 | ; Result should hav e | |
586 | ;Property Status As %Integer; (AHSTV) | |
587 | S AHDATA( AHSTV,1)=R ESULT.stat us D XREFN (AHSTV) | |
588 | ;Property Reason As %Integer; | |
589 | S AHREAS= +$O(^DIC(A HNODIC,"B" ,"REASON", 0)) | |
590 | S AHDATA( AHREAS,1)= RESULT.rea son D XREF N(AHREAS) | |
591 | ;Property SpecialPa ymentMetho d As %Inte ger; | |
592 | S AHSPEC= +$O(^DIC(A HNODIC,"B" ,"SP_PAY", 0)) | |
593 | S AHDATA( AHSPEC,1)= RESULT.spe cialPaymen tMethod D XREFN(AHSP EC) | |
594 | ;Property Route As %Integer; (AHRTE) | |
595 | S AHDATA( AHRTE,1)=R ESULT.rout e D XREFN( AHRTE) | |
596 | ; Last ru le/element | |
597 | S RULENAM E=RESULT.l astFiredRu leName,RN= 0 S:RULENA ME["." RUL ENAME=$P(R ULENAME,". ",2) | |
598 | F I=1:1 Q :'$D(^DIC( AHFILE,AHT S,100,I)) I $G(^DIC (AHFILE,AH TS,100,I,0 ))=RULENAM E S RN=I Q | |
599 | S EN=1 | |
600 | S T=$S(RU LENAME="": END,1:"QUI T") | |
601 | S AHLTS=A HFILE_U_AH TS_U_RN_U_ EN_U_T | |
602 | ; cost to check fla g and stat us of 0 se ts route t o 1 | |
603 | END ; | |
604 | END2 I $D( AHDATA(AHS TV)),$D(AH DATA(AHCTC )),AHDATA( AHSTV,1)=0 ,AHDATA(AH CTC,1)=1 S AHDATA(AH RTE,1)=1 | |
605 | ;K A,AHEX ,AHIF,AHDT ,B,EN,I,P, PR,R1,R2,R EG,RN,T,V, VAR,X,Y,Z | |
606 | END3 ;K OB J,OBJPROPS ,cdef,coun t,SERVICE, USERTOKEN, RESULT | |
607 | K V,X,AIN OUNS,J,K,L ,A,B,FIEN, NIEN,NZ,SE RVICE | |
608 | K RN,EN,T ,DEBUG | |
609 | K AHEX,AH IF,AHDT,P, PR,R1,R2,R EG,VAR,Y,Z | |
610 | Q | |
611 | ; evaluat e AI test. Copy of AHCJAE | |
612 | /* | |
613 | ENTRY ; | |
614 | K OBJ,ALL NOUNS | |
615 | ENTRY1 ; | |
616 | S (AHSTV, AHERV,AHRT E,AHQUIT,A HCTC)="",U ="^" | |
617 | G END:'$D (AHFILE),E ND:'AHFILE ,END:'$D(A HTS) | |
618 | G END:'$D (^DIC(AHFI LE,AHTS,0) ) S AHTSX= ^(0) | |
619 | S Y=+$P(A HTSX,U,4) G END:'Y S AHOPDIC=Y | |
620 | S Y=+$P(A HTSX,U,5) G END:'Y S AHNODIC=Y | |
621 | S Y=+$P(A HTSX,U,6) G END:'Y S AHFNDIC=Y | |
622 | S Y=+$P(A HTSX,U,7) G END:'Y S AHPRDIC=Y | |
623 | S AHRTE=+ $O(^DIC(AH NODIC,"B", "ROUTE",0) ) | |
624 | S AHSTV=+ $O(^DIC(AH NODIC,"B", "STATUS",0 )) | |
625 | S AHCTC=+ $O(^DIC(AH NODIC,"B", "CTC",0)) | |
626 | S AHQUIT= +$O(^DIC(A HNODIC,"B" ,"QUIT",0) ) | |
627 | S AHDATA( AHQUIT,1)= $P(^DIC(AH NODIC,AHQU IT,1),"^", 2),V=AHQUI T D XREFN( V) | |
628 | S X=$O(^D IC(AHNODIC ,"B","ERRO R",0)) | |
629 | I X,$D(^D IC(AHNODIC ,X,1)) S A HERV=$P(^( 1),U,2) | |
630 | I AHSTV,A HERV K AHD ATA(AHSTV) S AHDATA( AHSTV,1)=A HERV,V=AHS TV | |
631 | ; backgro und AI tas ks | |
632 | ;I $D(^DI C(AHFILE,A HTS,2)),^( 2)'="",'$D (AHTSBG) X ^(2) G:AH DATA(AHQUI T,1)=1 END 3 | |
633 | S:'$D(AHD T) AHDT=DT S:AHDT'?7 N AHDT=DT | |
634 | S:'$D(AHR T) AHRT="T " S AHRT=$ E(AHRT,1) S:"TBI"'[A HRT AHRT=" T" | |
635 | K:AHRT="B " AHTR | |
636 | S A=+$P(A HTSX,U,10) ,B=+$P(AHT SX,U,11) S :'A A=AHDT S:'B B=AH DT | |
637 | I (AHDT<A )!(AHDT>B) G END2 | |
638 | ; default outcome. How do we do that? | |
639 | ;I $D(^DI C(AHFILE,A HTS,1)) S AHEX=^(1) I AHEX?1"$ v5^".E D S ET | |
640 | ; flat all n oun evalua tion | |
641 | I $D(ALLNOUN S) D Q | |
642 | . F FIEN=12, 13 D NEVAL ("$F"_FIEN ,"") | |
643 | . K ANO F I= 1:1:7 S TX T=$T(ANOUN S+I),TXT=$ P(TXT,";", 2) F J=1:1 :$L(TXT,U) S ANO(+$P (TXT,U,J)) =($P(TXT,U ,J)["*") | |
644 | . S NIEN=0 F S NIEN=$ O(^DIC(AHN ODIC,NIEN) ) Q:'NIEN D | |
645 | . . Q:'$D(AN O(NIEN)) | |
646 | . . S STM=$Z H D NEVAL( "$n"_NIEN, "") ;W:$D( AHDATA(NIE N)) " (Tim e=",$ZH-ST M,")" | |
647 | . Q | |
648 | ; start proc essing spe cific test | |
649 | S RN=0,EN=0 | |
650 | A1 S RN=$O (^DIC(AHFI LE,AHTS,10 0,RN)) | |
651 | I RN="" S EN ="",T="END " G A9 | |
652 | S EN=0,AHIF= 1 | |
653 | A2 S EN=$O (^DIC(AHFI LE,AHTS,10 0,RN,100,E N)) G A1:E N="",ER1:' $D(^(EN,1) ) | |
654 | S AHEX=^DIC( AHFILE,AHT S,100,RN,1 00,EN,1) W !,AHEX | |
655 | S AHEL=0 | |
656 | A3 S AHEL= AHEL+1,VAR =$P(AHEX,U ,AHEL),V=+ $E(VAR,3,9 99) G A2:V AR="" | |
657 | D NEVAL(V AR,"") | |
658 | G A3 */ | |
659 | ; evaluat e noun (ex cept for p roblems on es) and pu t it into object or write it | |
660 | NEVAL(VAR, OBJ,NZ) ; | |
661 | I VAR?1"$ v".E Q | |
662 | I VAR?1"$ o".E Q | |
663 | S V=$E(VA R,3,9999) | |
664 | ;W !,"Eva luating No un ",V," " ,VAR," ",$ G(NZ) I VA R?1"$n".E W ! ZW AHD ATA(V) | |
665 | ; if noun evaluated by BG tes t already | |
666 | I $D(AHDA TA(V)) K Y M Y=AHDAT A(V) G NEV ALX | |
667 | ; | |
668 | ; 3 - DIA GNOSIS (bu g in code) | |
669 | I V=3 Q | |
670 | ; 29 - BU G AT GETDX +9^CHMJ116 (using IC D code as IEN) | |
671 | I V=29 Q | |
672 | ; 37 - Va riable CPC used but not define d | |
673 | I V=37 Q | |
674 | ; 44 - OP VSD^CHMJ11 7 (Should be 118) | |
675 | I V=44 Q | |
676 | ; 59 - "D X_ADM^DX/A DM^DIAGNOS IS_AT_ADMI SSON" ADMI SSION is m isspelled | |
677 | I V=59 Q | |
678 | ; 69 - CH MJ124 is n ot there | |
679 | I V=69 Q | |
680 | ; 87 - "N UM_PROC_3_ DAYS_PRIOR ^#_PROC_3_ DAYS_PRIOR ^NUMBER_OF _PROC_3_DA YS_PRIOR" | |
681 | ; - co de is look ing for NU MBER_PROC_ 3_DAYS | |
682 | I V=87 Q | |
683 | ; 92 - "N UMBER_PROC EDURES_WEE K_PRIOR^NP WP^NUMBER_ PROCEDURES _WEEK_PRIO R" | |
684 | ; - co de is look ing for NU MBER_PROC_ WEEK_PRIOR | |
685 | I V=92 Q | |
686 | ; 97 - "N UM_PROC_YE AR_PRIOR^N PYP^NUMBER _PROCEDURE S_YEAR_PRI OR" | |
687 | ; - co de is look ing for NU MBER_PROC_ YEAR_PRIOR | |
688 | I V=97 Q | |
689 | ; 99 - "N UM_PROC_5_ DAYS_AFTER ^NP5DA^NUM BER_PROCED URES_5_DAY S_AFTER" | |
690 | ; - co de is look ing for NU MBER_PROC_ 5_DAYS_AFT ER | |
691 | I V=99 Q | |
692 | ; 101 - " NUM_PROC_5 _DAYS_PRIO R^NP5DP^NU MBER_PROCE DURES_5_DA YS_PRIOR" | |
693 | ; - c ode is loo king for N UMBER_PROC _5_DAYS_PR IOR | |
694 | I V=101 Q | |
695 | W:$D(DEBU G) !,"Proc essing tes t ",AHTS," rule ",$G (RN)," ele ment numbe r ",$G(EN) ," VAR ",V AR | |
696 | I VAR?1"$ F".E D Q | |
697 | . Q:'$D(^ DIC(AHFNDI C,V,1)) | |
698 | . ; for n ow, use lo ng descrip tion as th e name for the funct ion | |
699 | . S P=$P( ^DIC(AHFND IC,V,1),U, 3,4),REG=$ P(^DIC(AHF NDIC,V,0), U,3),REG=$ TR(REG,"_" ," ") | |
700 | . ; for n ow, use F# as name | |
701 | . D XREFF (V) | |
702 | . Q:$L(P) <2 | |
703 | . S X=$P( VAR,",",2, 999) K Y D @P | |
704 | . K AHDATA(V ) F I=1:1 Q:'$D(Y(I) ) S AHDAT A("F"_V,I) =Y(I) | |
705 | . W:$D(DEBUG ) !,"Funct ion ",V,"( ",$P(^DIC( AHFNDIC,V, 0),U,1,3), ") evaluat ed to ",Y( 1) | |
706 | . I $isobjec t(OBJ) X " S OBJ."_NZ _"=$G(Y(1) )" | |
707 | I VAR'?1" $n".E Q | |
708 | D XREFN(V ) | |
709 | K Y S Y(1 )="",X="" ;G A3:$D(A HDATA(V)) | |
710 | Q:'$D(^DI C(AHNODIC, V,1)) | |
711 | S X=^DIC(AHN ODIC,V,1) S:$E(X,1)= "V" Y(1)=$ P(X,U,2) | |
712 | S P=$P(X, U,3,4) D:$ L(P)>1 @P | |
713 | S X=^DIC( AHNODIC,V, 1) | |
714 | ; file li st (disabl ed for now ) | |
715 | I $E(X)=" F" Q | |
716 | I $E(X)=" F" K Y S Y (1)="^"_$P (X,U,6)_"" "B""," | |
717 | ; variabl e | |
718 | I $E(X)=" V" S Y(1)= $P(X,U,2) | |
719 | ; data (d o we need to do anyt hing else) | |
720 | I $E(X)=" D" | |
721 | F I=1:1 Q :'$D(Y(I)) S AHDATA (V,I)=Y(I) | |
722 | ; DOUBLE | |
723 | I V=303 S :Y(1)'?1.N 1"."1.N Y( 1)=Y(1)_". 00" | |
724 | ; 300 is bugged. C lear 2-n | |
725 | I V=300 F I=2:1:$O( Y(""),-1) K Y(I) | |
726 | ;I $D(DEB UG) D | |
727 | . W !,X | |
728 | . W !,"Noun ",V,"(",$P (^DIC(AHNO DIC,V,0),U ),U,$P(^DI C(AHNODIC, V,0),U,3), ") " | |
729 | . W:'$D(ANO( V)) "(unus ed) " | |
730 | . W "- type " | |
731 | . S VT=^DIC( AHNODIC,V, 1) | |
732 | . I $E(VT )="F" W "L ist" | |
733 | . I $E(VT)=" V",$P(VT,U ,3,4)?.1"^ " W:$P(VT, U,2)="" "V ariable (b lank)" W:$ P(VT,U,2)' ="" "Varia ble (",$P( VT,U,2),") " | |
734 | . I $E(VT)=" V",$P(VT,U ,3,4)'?.1" ^" W "Vari able" | |
735 | . I $E(VT)=" D" W "Data " | |
736 | . W " ",?7 5," evalua ted to ",$ G(Y(1)) | |
737 | NEVALX ; | |
738 | I $isobject( OBJ) D | |
739 | . ;;S NZ=$$P AR($P(^DIC (AHNODIC,V ,0),U,3)) | |
740 | . ;;Q:'$D(OB JPROPS(NZ) ) | |
741 | . I OBJPROPS (NZ)="" D Q | |
742 | . . I $O(Y(1 ))="" X:$G (Y(1))'="" "S OBJ."_ NZ_"=$G(Y( 1))" Q ;W !,"OBJ.",N Z,"=",$G(Y (1)) | |
743 | . . S X=1/0 ; error ou t trying t o put mult iple data into singl e field | |
744 | . I OBJPROPS (NZ)="date " D Q | |
745 | . . S X=Y(1) D H^%DTC X "S OBJ." _NZ_"=$ZDA TE(%H,3)" | |
746 | . I '$O(Y(1) ),$G(Y(1)) ="" Q | |
747 | . F I=1:1 Q: '$D(Y(I)) X "D OBJ. "_NZ_".Ins ert(Y(I))" ;W !,"OBJ .",NZ,".In sert(""",Y (I),""")" | |
748 | . ;I $O(Y(1) ),OBJPROPS (NZ)'="lis t" W !,NZ, " fails mu ltiple tes t",! ZW Y | |
749 | Q | |
750 | ; exit | |
751 | ER0 ; | |
752 | ER1 ; | |
753 | S:'$D(AHF ILE) AHFIL E="" S:'$D (AHTS) AHT S="" S:'$D (RN) RN="" | |
754 | S:'$D(EN) EN="" S:' $D(AHSTV) AHSTV="" S :'$D(AHERV ) AHERV="" | |
755 | S AHLTS=A HFILE_U_AH TS_U_RN_U_ EN_U_"ERRO R",AHERROR ="" | |
756 | I AHST V,AHERV K AHDATA(AHS TV) S AHDA TA(AHSTV,1 )=AHERV,V= AHSTV D XR EFN(V) | |
757 | G END | |
758 | ; part of evaluate AI logic | |
759 | XREFN(V) Q :'$D(^DIC( AHNODIC,V, 0)) | |
760 | S Z=$P(^D IC(AHNODIC ,V,0),U,1) S:Z'="" A HDATA("XR" ,Z,V)="" | |
761 | S Z=$P(^D IC(AHNODIC ,V,0),U,3) S:Z'="" A HDATA("XR" ,Z,V)="" | |
762 | Q | |
763 | ; part of evaluate AI logic | |
764 | XREFF(V) Q :'$D(^DIC( AHFNDIC,V, 0)) | |
765 | S Z=$P(^D IC(AHFNDIC ,V,0),U,1) S:Z'="" A HDATA("XR" ,"F"_Z,V)= "" | |
766 | S Z=$P(^D IC(AHFNDIC ,V,0),U,3) S:Z'="" A HDATA("XR" ,"F"_Z,V)= "" | |
767 | S Z=$P(^( 0),U,3) S: Z'="" AHDA TA("XR","F "_Z,V)="" Q | |
768 | ; DD tabl e display? | |
769 | DUMPAI ; | |
770 | Q:$G(DIC) ="" | |
771 | S U="^" K GLAZ | |
772 | D DAI1(DI C) | |
773 | S IEN=0 | |
774 | ;F I | |
775 | F C=1:1:G LAZ D | |
776 | Q | |
777 | DAI1(DIC) ; | |
778 | N FLD S F LD=0 | |
779 | N GLAZ1,G LAZS | |
780 | F S FLD= $O(^DD(DIC ,FLD)) Q:' FLD D | |
781 | . S DZ=^D D(DIC,FLD, 0) W !,FLD ," = ",DZ | |
782 | . I $P(DZ ,U,2)'?1.N .1"."1.N S GLAZ($I(G LAZ),$P(DZ ,U,4))=1 W ! ZW GLAZ Q | |
783 | . I $P(^D D($P(DZ,U, 2),.01,0), U,2)="W" S GLAZ($I(G LAZ),$P(DZ ,U,4))=1 W ! ZW GLAZ Q | |
784 | . K GLAZS M GLAZS=G LAZ K GLAZ | |
785 | . D DAI1( $P(DZ,U,2) ) | |
786 | . M GLAZ1 =GLAZ K GL AZ M GLAZ= GLAZS | |
787 | . S SFLD= "" S DZ=^D D(DIC,FLD, 0) | |
788 | . W !,"Me rging",! Z W GLAZ1 W ! ZW GLAZ | |
789 | . F S SF LD=$O(GLAZ 1(SFLD)) Q :'SFLD D | |
790 | . . W !,S FLD | |
791 | . . M GLA Z($I(GLAZ) ,$P(DZ,U,4 ))=GLAZ1(S FLD) W ! Z W GLAZ K G LAZ1(SFLD) | |
792 | . W !,"Do ne merging " W ! ZW G LAZ | |
793 | Q | |
794 | ; write t ests in sp readsheet format | |
795 | DTEST ; | |
796 | R !,"Excl ude expire d: Y/",EXP S:EXP="" EXP="Y" | |
797 | R !,"Summ ary or Det ail: D/",D S S:DS="" DS="D" | |
798 | S DIC=741 100,U="^", IEN1=0 K N OUNS | |
799 | I DS="S" D | |
800 | . S FLIST =".01^.02^ .04^.05^.0 6^.07^.1^. 11^.12^1.0 1^3.01" | |
801 | . W !,"IE N" | |
802 | . F F=1:1 :$L(FLIST, U) S FD=^D D(DIC,$P(F LIST,U,F), 0) W ",",$ P(FD,U) W: FD["DEFAUL T OUTCOME" ",",$P(FD ,U) | |
803 | E W !,"I EN,RULE IE N,RULE DES CRIPTION,E LEMENT DAT A,ELEMENT DATA" | |
804 | F S IEN1 =$O(^DIC(D IC,IEN1)) Q:'IEN1 D | |
805 | . S DATA= ^DIC(DIC,I EN1,0),DC= 0,WRT="" | |
806 | . I EXP=" Y",$P(DATA ,U,11)'="" Q | |
807 | . F F=1:1 :$L(FLIST, U) S FD=^D D(DIC,$P(F LIST,U,F), 0) D | |
808 | . . S I=$ P(FD,U,4) | |
809 | . . S V=$ P($G(^DIC( DIC,IEN1,+ $P(I,";")) ),U,$P(I," ;",2),$S(+ I=1:999,1: $P(I,";",2 ))) | |
810 | . . S $P( WRT,",",$I (DC))=V | |
811 | . . I +I= 1 S $P(WRT ,",",$I(DC ))=$$AIDC( V) | |
812 | . S RIEN= 0 | |
813 | . I $G(DS )="S" W !, IEN1,",",W RT Q | |
814 | . S DC=0, WRT="" | |
815 | . F S RI EN=$O(^DIC (DIC,IEN1, 100,RIEN)) Q:'RIEN D | |
816 | . . S $P( WRT,",",1) =RIEN | |
817 | . . S $P( WRT,",",2) =$G(^DIC(D IC,IEN1,10 0,RIEN,0)) | |
818 | . . S EIE N=0 | |
819 | . . F S EIEN=$O(^D IC(DIC,IEN 1,100,RIEN ,100,EIEN) ) Q:'EIEN D | |
820 | . . . S E L=^DIC(DIC ,IEN1,100, RIEN,100,E IEN,1) | |
821 | . . . S $ P(WRT,",", 3)=EL | |
822 | . . . S $ P(WRT,",", 4)=$$AIDC( EL) | |
823 | . . . I E L["$n" F J =1:1:$L(EL ,"$n") S N OUNS(+$P(E L,"$n",J)) =1 | |
824 | . . . W ! ,IEN1,",", WRT | |
825 | Q | |
826 | ; write N OUNS in sp readsheet format | |
827 | DNOUN ; | |
828 | S DIC=741 100.01,U=" ^",IEN1=0 | |
829 | S FLIST=" .01^.02^.0 3^1.01^1.0 2^1.03^1.0 4^1.05^1.0 6" | |
830 | W !,"IEN" | |
831 | F F=1:1:$ L(FLIST,U) S FD=^DD( DIC,$P(FLI ST,U,F),0) W ",",$P( FD,U) | |
832 | F S IEN1 =$O(^DIC(D IC,IEN1)) Q:'IEN1 D | |
833 | . I $D(NO UNS),'$D(N OUNS(IEN1) ) Q | |
834 | . S DATA= ^DIC(DIC,I EN1,0),DC= 0,WRT="" | |
835 | . F F=1:1 :$L(FLIST, U) S FD=^D D(DIC,$P(F LIST,U,F), 0) D | |
836 | . . S I=$ P(FD,U,4) | |
837 | . . S V=$ P($G(^DIC( DIC,IEN1,+ $P(I,";")) ),U,$P(I," ;",2)) | |
838 | . . S $P( WRT,",",$I (DC))=V | |
839 | . S RIEN= 0 | |
840 | . I '$O(^ DIC(DIC,IE N1,100,0)) W !,IEN1, ",",WRT Q | |
841 | . F S RI EN=$O(^DIC (DIC,IEN1, 100,RIEN)) Q:'RIEN D | |
842 | . . S $P( WRT,",",DC +1)=^DIC(D IC,IEN1,10 0,RIEN,0) | |
843 | . . ;S $P (DATA,",", DC+2)=$G(^ DIC(DIC,IE N1,100,RIE N,0)) | |
844 | . . W !,I EN1,",",WR T | |
845 | Q | |
846 | ; example of invoki ng remote server wit h access p arameters | |
847 | SERV(in) ; | |
848 | s x=##cla ss(Testser vice.Tests erviceSoap ).%New() | |
849 | s usertok en=##class (%SOAP.Sec urity.User nameToken) .Create(" DNS glazay","c lammy11") | |
850 | d x.Secur ityOut.Add Token(user token) | |
851 | s out=x.C LAIM(in) | |
852 | d WOBJ(ou t) | |
853 | q | |
854 | ANOUNS ; | |
855 | ;1*^4^6^7 ^10^11^13^ 14^15*^19* ^31^33*^36 *^40*^43^4 5*^47*^50* ^51*^52*^6 0^63*^68^6 9^74*^80*^ 86*^88^105 ^106^110^1 11^113^114 ^115^116*^ 117*^118*^ 119*^120*^ 121* | |
856 | ;122*^123 *^124*^125 *^126*^127 *^129*^130 ^131^132^1 34^135^136 ^138^139^1 40^142^143 ^144^145^1 46^147^148 ^150^151^1 52^153^154 ^155^156^1 57^158^159 | |
857 | ;160^161^ 163^164^16 5^166^167^ 168^169^17 0^171^172^ 173^174^17 6^177^178^ 179^180^18 1^182^183^ 184^185^18 7^188^189^ 190^194^19 5^196^197^ 198 | |
858 | ;202*^203 ^204^205^2 06^207^208 ^209^210^2 11^212^213 ^214^215^2 16^217^218 ^219^220^2 21^222^223 ^224^225^2 26^227*^22 8*^229*^23 0^231*^232 ^233^234 | |
859 | ;235^236^ 237^238^23 9^240^241^ 242^243^24 4^245*^246 *^247^248^ 249^250^25 1*^252*^25 3*^254*^25 5*^256*^25 7*^259^260 *^261*^262 ^263*^264^ 265*^266^2 67*^268 | |
860 | ;270^271^ 272*^275^2 76^277^278 ^279^280^2 81*^282^28 3^284^285^ 286*^287^2 88^289^290 ^291^292^2 93^294^295 ^296^297*^ 298*^299^3 00*^301^30 2*^303*^30 4* | |
861 | ;305^306* | |
862 | BNOUNS ; | |
863 | ;4^14^114 ^182^226^2 30^299 | |
864 | ; | |
865 | ; write t ext approp riate for copy/paste into requ est object class | |
866 | WCLASS ; | |
867 | R !,"List s (Y/N): " ,LYN | |
868 | R !,"Cons tants (Y/N ): ",CYN | |
869 | ;K ANO F I=1:1:7 S TXT=$T(ANO UNS+I),TXT =$P(TXT,"; ",2) F J=1 :1:$L(TXT, U) S ANO(+ $P(TXT,U,J ))=($P(TXT ,U,J)["*") | |
870 | ;K ANO F I=1:1:1 S TXT=$T(BNO UNS+I),TXT =$P(TXT,"; ",2) F J=1 :1:$L(TXT, U) S ANO(+ $P(TXT,U,J ))=($P(TXT ,U,J)["*") | |
871 | S NOUN=0, U="^" | |
872 | F S NOUN =$O(ANO(NO UN)) Q:'NO UN D | |
873 | . S NZ=^D IC(741100. 01,NOUN,0) ,N1=$G(^DI C(741100.0 1,NOUN,1)) | |
874 | . I LYN=" N"!(LYN="n "),$E(N1)= "F" Q | |
875 | . I CYN=" N"!(CYN="n "),$E(N1)= "V"!($E(N1 )="D"),$P( N1,U,3)="" Q | |
876 | . W !,! | |
877 | . W !," / // Noun #" ,NOUN," (" ,$P(NZ,U,3 ),")" W:$P (NZ,U)'=$P (NZ,U,3) " , (",$P(N Z,U),")" W "</br>" | |
878 | . W !," / //" | |
879 | . F I=1:1 Q:'$D(^DI C(741100.0 1,NOUN,101 ,I,0)) W !," /// ", ^(0) | |
880 | . W:$D(^D IC(741100. 01,NOUN,10 1)) "</br> ",!," ///" | |
881 | . W !," / // Type: " ,$S($E(N1) ="F":"List ",$E(N1)=" D":"Data", $E(N1)="V" :"Variable ",1:""),"< /br>" | |
882 | . I $E(N1 )="F" W !, " /// List #: ",+$P( N1,"(",2), !," /// Li st Name: " ,$P(@(U_$P (N1,U,6)_" 0)"),U),"< /br>" | |
883 | . I $P(N1 ,U,2)'="" W !," /// Default: " ,$P(N1,U,2 ),"</br>" | |
884 | . I $P(N1 ,U,3)'="" W !," /// Evaluate l ogic: ",$P (N1,U,3,4) | |
885 | . W !,"Pr operty ",$ $PAR($P(NZ ,U,3))," A s %String; " | |
886 | Q | |
887 | PAR(A) ; | |
888 | N I,B,F | |
889 | S F=0,B=" " | |
890 | F I=1:1:$ L(A) D | |
891 | . I $E(A, I)?1.N S:I =1 B="x" S B=B_$E(A, I),F=0 Q | |
892 | . I $E(A, I)="_" S F =1 Q | |
893 | . I F S B =B_$E(A,I) ,F=0 Q | |
894 | . ; FIND BETTER LOW ERCASE? | |
895 | . S B=B_$ C($A(A,I)+ 32) | |
896 | Q B | |
897 | ; general write obj ect | |
898 | WOBJ(OBJ) ; | |
899 | I '$ISOBJ ECT(OBJ) Q | |
900 | S CN=$P(O BJ,"@",2) | |
901 | S cdef=## class(%Dic tionary.Cl assDefinit ion).%Open Id(CN) | |
902 | S count=c def.Proper ties.Count () | |
903 | F i=1:1:c ount D | |
904 | . S Prop= cdef.Prope rties.GetA t(i).Name, PType=cdef .Propertie s.GetAt(i) .Collectio n | |
905 | . I PType ="" W !,Pr op," = " X "W OBJ."_ Prop Q | |
906 | . X "S co unt1=OBJ." _Prop_".Co unt()" W ! ,Prop," = list (",co unt1,")" | |
907 | . F j=1:1 :count1 X "S V=OBJ." _Prop_".Ge tAt(j)" W !," (",j, ")=",V I j >10 W !," ......" Q | |
908 | Q | |
909 | ; calcula te CRC cod e for AI l ist | |
910 | LISTCRC(LI EN) ; | |
911 | ;Q FILENU M | |
912 | N GLB S G LB=$G(@GLA ZDIC@(7411 00.01,LIEN ,1)),GLB=$ P(GLB,"^", 6),FILENUM =+$P(GLB," (",2) | |
913 | S CS=0 F I=1:1 Q:'$ D(@GLAZCHM @(FILENUM, I)) S V=@ GLAZCHM@(F ILENUM,I,0 ) S:$E(V,* )="Z" V=$E (V,1,*-1) S CS=CS+$Z CRC(V,7) | |
914 | Q CS | |
915 | ; set scr atch area with copie s of AI da ta structu res where converted codes will be stored | |
916 | SETUP ; | |
917 | ; If ther e are save d ^DD,^DIC and ^CHMI DC globals for the c onversion, replace t he current ones | |
918 | ; with sa ved ones | |
919 | ; Note: A dded ,0 to IF to dis able clear ing and re storation of data | |
920 | I $D(^AIP ROD.DIC),$ D(^AIPROD. DD),$D(^AI PROD.CHMDI C),0 D | |
921 | . S A=0 | |
922 | . F S A= $O(^AIPROD .DIC(74110 0,A)) Q:A= "" D | |
923 | . . K SCR M SCR=^DI C(741100,A ,102) | |
924 | . . K ^DI C(741100,A ) | |
925 | . . M ^DI C(741100,A )=^AIPROD. DIC(741100 ,A) | |
926 | . . ;M ^D IC(741100, A,102)=SCR | |
927 | . F I=741 100.01,741 100.02,741 100.03,741 100.04 D | |
928 | . . K ^DD (I) M ^DD( I)=^AIPROD .DD(I) | |
929 | . . K ^DI C(I) M ^DI C(I)=^AIPR OD.DIC(I) | |
930 | . S I=741 110 | |
931 | . F S I= $O(^AIPROD .DIC(I)) Q :I>741114 Q:I="" D | |
932 | . . I $D( ^DIC(I,0," GL")),^DIC (I,0,"GL") '?1"^CHMDI C(741".E Q | |
933 | . . ;W I, " " | |
934 | . . K ^DI C(I) M ^DI C(I)=^AIPR OD.DIC(I) | |
935 | . . K ^DD (I) M ^DD( I)=^AIPROD .DD(I) | |
936 | . . K ^CH MDIC(I) M ^CHMDIC(I) =^AIPROD.C HMDIC(I) | |
937 | . S I=741 110 | |
938 | . F S I= $O(^AIPROD .CHMDIC(I) ) Q:I>7411 14 Q:I="" D | |
939 | . . I $D( ^DIC(I,0," GL")),^DIC (I,0,"GL") '?1"^CHMDI C(741".E Q | |
940 | . . ;W I, " " | |
941 | . . K ^DI C(I) M ^DI C(I)=^AIPR OD.DIC(I) | |
942 | . . K ^DD (I) M ^DD( I)=^AIPROD .DD(I) | |
943 | . . K ^CH MDIC(I) M ^CHMDIC(I) =^AIPROD.C HMDIC(I) | |
944 | ; Set the list of a ctive test s being ch ecked/conv erted | |
945 | K ACTIVE | |
946 | S GLAZDD= "^DD",GLAZ DIC="^DIC" ,GLAZCHM=" ^CHMDIC" | |
947 | D SETACT | |
948 | Q | |
949 | SETACT ; S et Active AI tests | |
950 | F I=1,2,3 ,4,16,21,3 1,32,33,55 ,56,65,102 ,103,180,1 82,184,186 ,221,223,2 62 S ACTIV E(I)=1 | |
951 | F I=269,2 75,277,278 ,280,281,2 83,284,286 ,288,289,2 90,291,292 ,293,294,2 95,296,297 S ACTIVE( I)=1 | |
952 | F I=299,3 01,302,304 ,305,306,3 09,314,315 ,316,318,3 19,320,325 ,326,327,3 29,331,339 S ACTIVE( I)=1 | |
953 | F I=345,3 46,347,348 ,349,350,3 51,352,359 ,360,361,3 62,363,364 ,365,366,3 68,369,370 S ACTIVE( I)=1 | |
954 | F I=371,3 72,373,375 ,376,377,3 78,379,380 ,381,384,3 85,386,387 ,388,389,3 90,391 S A CTIVE(I)=1 | |
955 | F I=392,3 93,394,395 ,396,397,3 98,399,400 ,401,402,4 03 S ACTIV E(I)=1 | |
956 | ; add 408 ,409,410,4 23,426,427 ,428 for n ow since w e are not sure the s can will p ick them u p | |
957 | ;F I=408, 409,410,42 3,426,427, 428 S ACTI VE(I)=1 | |
958 | ; these a re active in HRDEV | |
959 | ;F K=181, 235,406,40 8,410,427, 428,429,43 0,431,432, 433 S ACTI VE(K)=2 | |
960 | F I="TEST #179","TE ST #42","T EST #405", "TEST #425 ","TEST #4 02","TEST #452","TES T #450" D | |
961 | . S K=$O( ^DIC(74110 0,"B",I,"" )) S:$G(AC TIVE(K))=" " ACTIVE(K )=3 | |
962 | F I="TEST #422","TE ST #418"," TEST #458" ,"TEST #46 1","TEST # 472","TEST #455","TE ST #424" D | |
963 | . S K=$O(^DI C(741100," B",I,"")) S:$G(ACTIV E(K))="" A CTIVE(K)=3 | |
964 | ; Run data s can to add other act ive tests | |
965 | S I=0 F S I=$O(^CH MSERV(I)) Q:I="" D | |
966 | . F J=1:1 :7 S K=$P( $G(^CHMSER V(I,102,J, 0)),"^",2) I K'="" S :$G(ACTIVE (K))="" AC TIVE(K)=2 | |
967 | S I=0 F S I=$O(^CH MICDX(I)) Q:I="" D | |
968 | . F J=1:1 :7 S K=$P( $G(^CHMICD X(I,102,J, 0)),"^",2) I K'="" S :$G(ACTIVE (K))="" AC TIVE(K)=2 | |
969 | S I=0 F S I=$O(^CH MDIC(74100 2.16,I)) Q :I="" D | |
970 | . S K=$P( $G(^CHMDIC (741002.16 ,I,0)),"^" ,2) I K'=" " S:$G(ACT IVE(K))="" ACTIVE(K) =2 | |
971 | ; test #3 24 is not active any more? | |
972 | ;K ACTIVE (365) | |
973 | ; PHARMAC Y TEST (#2 69) is dec lared inac tive | |
974 | K ACTIVE( 269) | |
975 | Q | |
976 | SETACTN ; | |
977 | S TIEN=0 | |
978 | F S TIEN =$O(ACTIVE (TIEN)) Q: 'TIEN D | |
979 | . S RIEN= 0 | |
980 | . F S RI EN=$O(^DIC (741100,TI EN,100,RIE N)) Q:'RIE N D | |
981 | . . S EIE N=0 | |
982 | . . F S EIEN=$O(^D IC(741100, TIEN,100,R IEN,100,EI EN)) Q:'EI EN D | |
983 | . . . S E L=^DIC(741 100,TIEN,1 00,RIEN,10 0,EIEN,1) | |
984 | . . . F I =1:1:$L(EL ,"^") I $P (EL,"^",I) ?1"$n".E D | |
985 | . . . . S NIEN=$E($ P(EL,"^",I ),3,999),N 1=^DIC(741 100.01,NIE N,1) | |
986 | . . . . S NN=$TR($P (^DIC(7411 00.01,NIEN ,0),"^",3) ,"_"," ") | |
987 | . . . . I $TR($P(N1 ,"^",3,4), "^")'="" S ACTIVEN(N N)=$P(N1," ^",3,4),AC TIVEN1(NN, TIEN,RIEN, EIEN)=1 | |
988 | Q | |
989 | ; find IC D codes | |
990 | RFIND ; | |
991 | I $D(^GLA Z("RFIND2" ,"RTN")) S RTN=^GLAZ ("RFIND2", "RTN") | |
992 | E S RTN= "CH.zz" | |
993 | K Z | |
994 | S IEN=0 F S IEN=$O (^CHMSERV( IEN)) Q:'I EN S NZ=$ G(^CHMSERV (IEN,0)) I NZ'["ICD- 10" S Z($I (Z))=$P(NZ ,"^"),Z(Z, "TYPE")="P CS-"_$P(NZ ,"^",5) | |
995 | S IEN=0 F S IEN=$O (^CHMICDX( IEN)) Q:'I EN S NZ=$ G(^CHMICDX (IEN,0)) I $P(NZ,"^" ,24)'=1 S Z($I(Z))=$ P(NZ,"^",2 ),Z(Z,"TYP E")="CM-"_ $S($P(NZ," ^",24)'=1: "ICD-9",1: "ICD-10") | |
996 | ;W !,"Sea rching" | |
997 | F S RTN= $O(^|"DEVS LA"|ROUTIN E(RTN)) Q: $E(RTN,1,2 )'="CH" D | |
998 | . S ^GLAZ ("RFIND2", "RTN")=RTN | |
999 | . S TI=$Z H,MX=^|"DE VSLA"|ROUT INE(RTN,0, 0) | |
1000 | . ;X "ZL "_RTN_" F II=1:1:MX S T=$T("_R TN_"+II) F JJ=1:1:MX L S CODE=Z (JJ) I T[( CODE) W !, RTN,""+"", JJ,"" "",C ODE,"" "", T" | |
1001 | . F II=1: 1:MX S T=^ |"DEVSLA"| ROUTINE(RT N,0,II) I T?.E1"""". 1AN.E D | |
1002 | . . F JJ= 1:1:Z S CO DE=Z(JJ) I T[(""""_C ODE_"""") D | |
1003 | . . . M ^ GLAZ("RFIN D2","FIND" ,RTN,II,CO DE)=Z(JJ) | |
1004 | . . . S ^ GLAZ("RFIN D2","FIND" ,RTN,II,CO DE)=T | |
1005 | . . . S ^ GLAZ("RFIN D2","FIND1 ",Z(JJ,"TY PE"),RTN,I I,CODE)=T | |
1006 | . ;W " ", $ZH-TI*100 0 | |
1007 | Q | |
1008 | ; return from info for Noun ( class,file number,SQL , etc) | |
1009 | NOUNINF(NI EN) | |
1010 | S OUT="" | |
1011 | Q:NIEN="" "" | |
1012 | Q:'$D(^DI C(741100.0 1,NIEN)) " " | |
1013 | S NZ1=$G( ^DIC(74110 0.01,NIEN, 1)) Q:NZ1' ?1"F".E "" | |
1014 | S FILENUM =+$P(NZ1," CHMDIC(",2 ) Q:'FILEN UM "" | |
1015 | S RN="CH. CHAMPVAAIF D" S FOUND =0 | |
1016 | F S RN=$ O(^ROUTINE (RN)) Q:RN '["CH.CHAM PVAAIFD" D Q:FOUND | |
1017 | . I RN?1" CH.".E1"." 1N D | |
1018 | . . S CLA SNM=^ROUTI NE(RN,0,2) ,CLASNM=$P (CLASNM,"g enerated f or class " ,2),CLASNM =$P(CLASNM ," ") | |
1019 | . . I $E( CLASNM,*)= "." S CLAS NM=$E(CLAS NM,1,*-1) | |
1020 | . . S CLA SOBJ=##cla ss(%Dictio nary.Class Definition ).%OpenId( CLASNM) | |
1021 | . . I CLA SOBJ.Descr iption[("G enerated c lass for F ileMan Fil e Number: '"_FILENUM _"'") D | |
1022 | . . . S $ P(OUT,"^", 2)=FILENUM | |
1023 | . . . S $ P(OUT,"^", 3)=$P(^DIC (FILENUM,0 ),"^") | |
1024 | . . . S $ P(OUT,"^", 4)=CLASOBJ .SqlTableN ame | |
1025 | . . . S $ P(OUT,"^", 5)=$P(^DD( FILENUM,.0 1,0),"^") | |
1026 | . . . S $ P(OUT,"^") =$P(^DIC(7 41100.01,N IEN,0),"^" ) | |
1027 | . . . F I =1:1:CLASO BJ.Propert ies.Count( ) I CLASOB J.Properti es.GetAt(I ).Name'="I EN" S $P(O UT,"^",6) = CLASOBJ. Properties .GetAt(I). SqlFieldNa me Q | |
1028 | . . . S F OUND=1 | |
1029 | Q OUT | |
1030 | /* | |
1031 | ; scan da tabase for pointers to AI Test file to s ee which o nes are in use | |
1032 | AITESTS ; | |
1033 | k GLAZDX, GLAZDRG,GL AZPCS | |
1034 | S:'$D(CKT ST) CKTST= 999 | |
1035 | S A="^CHM DIC(741002 .16)" | |
1036 | F S A=$Q (@A) Q:A'[ "CHMDIC(74 1002.16" I A?1"^CHM DIC(741002 .16,"1.N1" ,0)" S B=$ P(@A,"^",2 ),XX=$I(GL AZDRG(+B)) I B=$G(CK TST) W !,A ,!,@A | |
1037 | ; | |
1038 | S A="^CHM ICDX" | |
1039 | F S A=$Q (@A) Q:A=" " D | |
1040 | . I A?1"^ CHMICDX("1 .N1",0)" S B=$P(@A," ^",19),XX= $I(GLAZMDX (+B)) I B= $G(CKTST) W !,A,!,@A | |
1041 | . I A?1"^ CHMICDX("1 .N1",102," 1.N1",0)" S B=$P(@A, "^",2),XX= $I(GLAZPID X(+B)) I B =$G(CKTST) W !,A,!,@ A | |
1042 | . I A?1"^ CHMICDX("1 .N1",102," 1.N1",101, "1.N1",0)" S B=$P(@A ,"^",2),XX =$I(GLAZHD X(+B)) I B =$G(CKTST) W !,A,!,@ A | |
1043 | ; | |
1044 | S A="^CHM SERV" | |
1045 | F S A=$Q (@A) Q:A=" " D | |
1046 | . I A?1"^ CHMSERV("1 .N1",2)" S B=$P(@A," ^"),XX=$I( GLAZMPCS(+ B)) I B=$G (CKTST) W !,A,!,@A | |
1047 | . I A?1"^ CHMSERV("1 .N1",101," 1.N1"."1.N 1",0)" S B =$P(@A,"^" ),XX=$I(GL AZHPCS(+B) ) I B=$G(C KTST) W !, A,!,@A | |
1048 | . I A?1"^ CHMSERV("1 .N1",102," 1.N1",0)" S B=$P(@A, "^",2),XX= $I(GLAZPIP CS(+B)) I B=$G(CKTST ) W !,A,!, @A | |
1049 | . I A?1"^ CHMSERV("1 .N1",102," 1.N1",101, "1.N1",0)" S B=$P(@A ,"^",2),XX =$I(GLAZHP CS(+B)) I B=$G(CKTST ) W !,A,!, @A | |
1050 | D AITESTS W(0) | |
1051 | W ! | |
1052 | D AITESTS W(1) | |
1053 | Q | |
1054 | AITESTSW(F LG) ; | |
1055 | F I=1:1:4 10 D | |
1056 | . I '$D(^ DIC(741100 ,I,0)) Q | |
1057 | . S USED= 0,WX=0 | |
1058 | . I $D(GL AZPIDX(I)) D:FLG WX W:FLG GLAZ PIDX(I)," in DX PI, " S USED=1 | |
1059 | . I $D(GL AZMDX(I)) D:FLG WX W :FLG GLAZM DX(I)," in DX 0 node , " S USE D=1 | |
1060 | . I $D(GL AZHDX(I)) D:FLG WX W :FLG GLAZH DX(I)," in DX Hist, " S USED= 1 | |
1061 | . I $D(GL AZPIPCS(I) ) D:FLG WX W:FLG GLA ZPIPCS(I), " in PCS P I, " S US ED=1 | |
1062 | . I $D(GL AZMPCS(I)) D:FLG WX W:FLG GLAZ MPCS(I)," in PCS 0 n ode, " S USED=1 | |
1063 | . I $D(GL AZHPCS(I)) D:FLG WX W:FLG GLAZ HPCS(I)," in PCS His t, " S US ED=1 | |
1064 | . I $D(GL AZDRG(I)) D:FLG WX W :FLG GLAZD RG(I)," in DRG, " S USED=1 | |
1065 | . I @$ZR[ "PHARMACY" D:FLG WX W:FLG " in PHARM, " S USED=1 | |
1066 | . I USED= 0 D:FLG WX W:FLG " U NUSED" | |
1067 | Q | |
1068 | */ | |
1069 | ||
1070 | /* | |
1071 | WX ; | |
1072 | Q:'$D(WX) | |
1073 | W !,I," (",$P(^DIC (741100,I, 0),"^"),") " K WX | |
1074 | Q | |
1075 | AITESTSX(F LG) ; | |
1076 | F I=1:1:4 10 D | |
1077 | . I '$D(^ DIC(741100 ,I,0)) Q | |
1078 | . S USED= 0,WX=0,WL= "" | |
1079 | . I $D(GL AZPIDX(I)) D:FLG WX W:FLG GLAZ PIDX(I)," in DX PI, " S USED=1 S $P(WL," ,")=GLAZPI DX(I) | |
1080 | . I $D(GL AZMDX(I)) D:FLG WX W :FLG GLAZM DX(I)," in DX 0 node , " S USE D=1 S $P(W L,",",2)=G LAZMDX(I) | |
1081 | . I $D(GL AZHDX(I)) D:FLG WX W :FLG GLAZH DX(I)," in DX Hist, " S USED= 1 S $P(WL, ",",3)=GLA ZHDX(I) | |
1082 | . I $D(GL AZPIPCS(I) ) D:FLG WX W:FLG GLA ZPIPCS(I), " in PCS P I, " S US ED=1 S $P( WL,",",4)= GLAZPIPCS( I) | |
1083 | . I $D(GL AZMPCS(I)) D:FLG WX W:FLG GLAZ MPCS(I)," in PCS 0 n ode, " S USED=1 S $ P(WL,",",5 )=GLAZMPCS (I) | |
1084 | . I $D(GL AZHPCS(I)) D:FLG WX W:FLG GLAZ HPCS(I)," in PCS His t, " S US ED=1 S $P( WL,",",6)= GLAZHPCS(I ) | |
1085 | . I $D(GL AZDRG(I)) D:FLG WX W :FLG GLAZD RG(I)," in DRG, " S USED=1 S $ P(WL,",",7 )=GLAZDRG( I) | |
1086 | . I @$ZR[ "PHARMACY" D:FLG WX W:FLG " in PHARM, " S USED=1 S $P(WL,"," ,8)=1 | |
1087 | . I USED= 0 D:FLG WX W:FLG " U NUSED" | |
1088 | . W !,I," ,",$P(^DIC (741100,I, 0),"^"),", ",WL | |
1089 | Q | |
1090 | */ | |
1091 | ||
1092 | /* Obsole te. We g ot the sou rce data | |
1093 | ; | |
1094 | ; Read th e new prod uction fil es. | |
1095 | RPROD ; | |
1096 | I $D(IO) C IO | |
1097 | K | |
1098 | S DIR="CH AMPVA_USER :[ DNS GLAZAY]" | |
1099 | S FMASK=" *TEST*.TXT " | |
1100 | D GETF^CH ICDOL(DIR, FMASK,"",. PRODFILE) | |
1101 | S GLAZDIC ="^DIC",LW AIEN="" | |
1102 | F FN=1:1: PRODFILE D | |
1103 | . S IO=$P (PRODFILE( FN),";",4) | |
1104 | . U 0 W ! ,$TR($J("" ,60)," "," -"),!,IO,! ,$TR($J("" ,60)," "," -") | |
1105 | . O IO:"R " | |
1106 | . S A=$ZU TIL(68,40, 1) | |
1107 | . F LN=1: 1 U IO R R ST S ZEOF= $ZEOF D:ZE OF=-1 WOLD ELEM Q:ZEO F=-1 S RS T=$TR(RST, $C(10,12,1 3)) D | |
1108 | . . ;U 0 W !,RST | |
1109 | . . ; Dat e: FEB 24, 2012 # 361 TES T #236 UC I: TST | |
1110 | . . I RST ?1"Date: " .E D | |
1111 | . . . S A IEN=$P(RST ,"# ",2)+0 | |
1112 | . . . S A INAME=$P(R ST,"# ",2, 9),AINAME= $$SLS^CHIC DOL($P(AIN AME," ",3, 999)) | |
1113 | . . . S A INAME=$$ST S^CHICDOL( $P(AINAME, " ",1,9)) | |
1114 | . . . I A IEN'=LWAIE N D | |
1115 | . . . . U 0 W !,RST ;,!,AIEN, " ",AINAME | |
1116 | . . . . S LWAIEN=AI EN | |
1117 | . . . . I AINAME'=$ P(^DIC(741 100,AIEN,0 ),"^") W ! ,"**",?20, $P(^DIC(74 1100,AIEN, 0),"^") | |
1118 | . . ; Rul e # 2 ( REVIEW COS METIC DRUG S IF GREAT ER THAN OR EQUAL TO 18 YRS) | |
1119 | . . I RST ?1"Rule # ".E D | |
1120 | . . . D W OLDELEM | |
1121 | . . . S R IEN=+$P(RS T," ",3),R TITLE=$P(R ST,"(",2,9 99),RTITLE =$$STS^CHI CDOL(RTITL E),RTITLE= $E(RTITLE, 1,*-1) | |
1122 | . . . U 0 W !,RST ; ,!,RIEN," ",RTITLE | |
1123 | . . . S O RTITLE=$G( ^DIC(74110 0,AIEN,100 ,RIEN,0)) | |
1124 | . . . I R TITLE'=ORT ITLE W !," **",?20,$S (ORTITLE=" ":"None",1 :ORTITLE) | |
1125 | . . . S E LEMFLG=0 | |
1126 | . . ; E lement 1: IF OHI PAYMENT AM OUNT GREAT ER THAN "0 " | |
1127 | . . I RST ?1" Eleme nt ".E D | |
1128 | . . . S E IEN=+$P(RS T,"Element ",2) | |
1129 | . . . S E DATA=$$STS ^CHICDOL($ P(RST,":", 2)),EDATA= $$SLS^CHIC DOL(EDATA) | |
1130 | . . . S F L="F",X=$G (^DIC(7411 00,AIEN,10 0,RIEN,100 ,EIEN,1)) | |
1131 | . . . D A I4 S Y=$$S LS^CHICDOL (Y),Y=$$ST S^CHICDOL( Y),Y=$TR(Y ,"_"," ") | |
1132 | . . . U 0 W !,RST | |
1133 | . . . I R ST["STARTS WITH" S X =1/0 | |
1134 | . . . ;I EDATA'=Y W !,"**",?2 0,Y H 1 | |
1135 | . . . I E DATA'=Y S ELEMFLG=1 S NEWELEM( $I(NEWELEM ))=EDATA | |
1136 | . ;U 0 W !,LN," Lin es read" | |
1137 | . C IO | |
1138 | ; | |
1139 | Q | |
1140 | WOLDELEM ; | |
1141 | U 0 | |
1142 | Q:$G(ELEM FLG)'=1 | |
1143 | S ELEMFLG =0 | |
1144 | I $G(AIEN )="" W 1/0 | |
1145 | I $G(RIEN )="" W 1/0 | |
1146 | S EIEN=0 | |
1147 | W !,"Curr ent Rule: " | |
1148 | I '$D(^DI C(741100,A IEN,100,RI EN,100)) W !,"** N one" | |
1149 | F S EIEN =$O(^DIC(7 41100,AIEN ,100,RIEN, 100,EIEN)) Q:'EIEN D | |
1150 | . S X=^DI C(741100,A IEN,100,RI EN,100,EIE N,1),FL="F " | |
1151 | . D AI4 S Y=$$SLS^C HICDOL(Y), Y=$$STS^CH ICDOL(Y),Y =$TR(Y,"_" ," ") | |
1152 | . W !,"** ",EIEN, " ",Y | |
1153 | Q | |
1154 | */ | |
1155 | ; Populat e Test Nou ns class | |
1156 | POPW03 ; | |
1157 | K OBJPROP S | |
1158 | S cdef=## class(%Dic tionary.Cl assDefinit ion).%Open Id("W03Dat a.TestNoun s") | |
1159 | S count=c def.Proper ties.Count () | |
1160 | F i=1:1:c ount S OBJ PROPS(cdef .Propertie s.GetAt(i) .Name)=1 | |
1161 | S AIEN=0 | |
1162 | F S AIEN =$O(^DIC(7 41100,AIEN )) Q:'AIEN D | |
1163 | . S OBJ=# #CLASS(W03 Data.TestN ouns).%New () | |
1164 | . S OBJ.a iTestName= $P(^DIC(74 1100,AIEN, 0),"^") | |
1165 | . S RIEN= 0 F S RIE N=$O(^DIC( 741100,AIE N,100,RIEN )) Q:'RIEN D | |
1166 | . . S EIE N=0 F S E IEN=$O(^DI C(741100,A IEN,100,RI EN,100,EIE N)) Q:'EIE N D | |
1167 | . . . S E LEM=^DIC(7 41100,AIEN ,100,RIEN, 100,EIEN,1 ) | |
1168 | . . . F V C=1:1:$L(E LEM,"^") S VAR=$P(EL EM,"^",VC) I VAR?1"$ n".E D | |
1169 | . . . . S NIEN=$E(V AR,3,99) | |
1170 | . . . . S NZ=$$PAR( $P($G(^DIC (741100.01 ,NIEN,0)), "^",3)) | |
1171 | . . . . I $D(OBJPRO PS(NZ)) X "S OBJ."_N Z_"=1" | |
1172 | . S sc=OB J.%Save() | |
1173 | Q | |
1174 | ; read ne w noun inf o | |
1175 | NINFO(TEST ,RULE,INFO ) ; | |
1176 | S FOUND=0 K INFO | |
1177 | F I=1:1 S DATA=$P($ T(NNGENE+I ),";",2,99 ) Q:DATA=" END" D Q :FOUND="EN D" | |
1178 | . I DATA? 1.N1",".E, $P(DATA,", ")=TEST,$F (","_$P(DA TA,",",2,9 9)_",","," _RULE_",") S FOUND=1 Q | |
1179 | . I 'FOUN D Q | |
1180 | . I DATA? 1"NOUN:".E S INFO("N OUN")=$P(D ATA,":",2) Q | |
1181 | . I DATA? 1"Noun:".E S INFO("N OUN")=$P(D ATA,":",2) Q | |
1182 | . I DATA? 1"Short Na me:".E S I NFO("SHORT ")=$P(DATA ,":",2) Q | |
1183 | . I DATA? 1"SHORT NA ME:".E S I NFO("SHORT ")=$P(DATA ,":",2) Q | |
1184 | . I DATA? 1"Full Nam e:".E S IN FO("FULL") =$P(DATA," :",2) Q | |
1185 | . I DATA? 1"FULL NAM E:".E S IN FO("FULL") =$P(DATA," :",2) Q | |
1186 | . I DATA? 1"Synonyms :".E S INF O("SYN")=$ P(DATA,":" ,2) Q | |
1187 | . I DATA? 1"SYNONYMS :".E S INF O("SYN")=$ P(DATA,":" ,2) Q | |
1188 | . I DATA? 1"Descript ion:".E S INFO("DESC ")=$P(DATA ,":",2) Q | |
1189 | . I DATA? 1"DESCRIPT ION:".E S INFO("DESC ")=$P(DATA ,":",2) Q | |
1190 | . S FOUND ="END" | |
1191 | Q | |
1192 | NNGENE ; | |
1193 | ;2 2,3 | |
1194 | ;N OUN:CPAP_O HI_ACCEPT_ 3 | |
1195 | ;S HORT NAME: CPAP_ACPT_ 3 | |
1196 | ;F ULL NAME:C PAP_OHI_AC CEPT_3 | |
1197 | ;S YNONYMS:CP AP_ACPT_3 | |
1198 | ;D ESCRIPTION :ACCEPT DX FOR CPAP WHEN OHI P RESENT | |
1199 | ; | |
1200 | ;2 2,4 | |
1201 | ;N OUN:CPAP_M ED_REVIEW_ 4 | |
1202 | ;S HORT NAME: CPAP_MED_R EV | |
1203 | ;F ULL NAME:C PAP_MED_RE VIEW_4 | |
1204 | ;S YNONYMS: | |
1205 | ;D ESCRIPTION :SENDS CPA P CLAIMS W ITH LISTED DIAGNOSIS FOR REVIE W IN AI TE ST #22 | |
1206 | ; | |
1207 | ;3 1,2 | |
1208 | ;N OUN:CALCIU M_INJECTIO N_ACCEPT | |
1209 | ;S HORT NAME: CALCIUM_IN J_ACC | |
1210 | ;F ULL NAME:C ALCIUM_INJ ECTION_ACC EPT | |
1211 | ;S YNONYMS:CA LCIUM_INJ_ ACC | |
1212 | ;D ESCRIPTION :NOUN CONT AINS A LIS T OF DIAGN OSIS CODES WHICH ALL OW A CALCI UM INJECTI ON TO BE P AID IN AI TEST #31 | |
1213 | ; | |
1214 | ;3 2,4 | |
1215 | ;N OUN:CALCIM AR_INJECTI ON_ACCEPT | |
1216 | ;S HORT NAME: CALCIMAR_I NJ | |
1217 | ;F ULL NAME:C ALCIMAR_IN JECTION_AC CEPT | |
1218 | ;S YNONYMS:CA LCIMAR_INJ | |
1219 | ;D ESCRIPTION :NOUN WHIC H CONTAINS A LIST OF DIAGNOSIS CODES WHI CH ALLOW A CALCIMAR INJECTION TO BE ACCE PTED IN AI TEST #32 | |
1220 | ; | |
1221 | ;3 3,2 | |
1222 | ;N OUN:DMSO_I NJECTION | |
1223 | ;S HORT NAME: DMSO_INJ | |
1224 | ;F ULL NAME:D MSO_INJECT ION | |
1225 | ;D ESCRIPTION :CONTAINS A LIST OF DXS THAT W ILL SET DM SO INJECTI ON TO PAY | |
1226 | ; | |
1227 | ;4 2,2 | |
1228 | ;N OUN:ELECTR ONIC_SPIRO METER | |
1229 | ;S HORT NAME: ELCTRC_SPR OMTR | |
1230 | ;F ULL NAME:E LECTRONIC_ SPIROMETER | |
1231 | ;D ESCRIPTION :CONTAINS A LIST OF PROCEDURE CODES THAT WILL SEND ELECTRONI C SPIROMET ER FOR MED REVIEW | |
1232 | ; | |
1233 | ;5 5,2 | |
1234 | ;N OUN:DENNIS _BROWNE_ST YLE_SPLINT | |
1235 | ;S HORT NAME: DENNIS_SPL NT | |
1236 | ;F ULL NAME:D ENNIS_BROW NE_STYLE_S PLINT | |
1237 | ;D ESCRIPTION :CONTAINS A LIST OF CONGENITAL TALIPES E QUINOVARUS DXS THAT WILL SET D ENNIS-BROW NE STYLE S PLINTS TO PAY | |
1238 | ; | |
1239 | ;5 6,2 | |
1240 | ;N OUN:ANGIST AT_TEST | |
1241 | ;S HORT NAME: ANGI_TST | |
1242 | ;F ULL NAME:A NGISTAT_TE ST | |
1243 | ;D ESCRIPTION :CONTAINS A LIST OF PAROXYSMAL SUPRAVENT RICULAR TA CHYCARDIA DXS THAT W ILL SET AN GISTAT TES T TO PAY | |
1244 | ; | |
1245 | ;1 02,4 | |
1246 | ;N OUN:PREVEN TIVE_CARE_ IMMUNIZATI ON_AGE_REJ ECT | |
1247 | ;S HORT NAME: PREV_IMMUN _REJECT | |
1248 | ;F ULL NAME:P REVENTIVE_ CARE_IMMUN IZATION_AG E_REJECT | |
1249 | ;S YNONYMS: | |
1250 | ;D ESCRIPTION :REJECTING LISTED IM MUNIZATION CODES IN AI TEST #1 02 WHEN AG E IS LESS THAN 6 WEE KS AFTER 1 0/6/97 | |
1251 | ; | |
1252 | ;1 35,2 | |
1253 | ;N OUN:PREVEN TIVE_VISIT _GYN_ACCEP T | |
1254 | ;S HORT NAME: PREV_VISIT _ACC | |
1255 | ;F ULL NAME:P REVENTIVE_ VISIT_GYN_ ACCEPT | |
1256 | ;S YNONYMS: | |
1257 | ;D ESCRIPTION :LISTS DIA GNOSES THA T ARE ACCE PTED FOR P REVENTIVE VISITS AND GYN EXAMS IN AI TES T #135 | |
1258 | ; | |
1259 | ;1 51,3 | |
1260 | ;N OUN:NONCOV ERED_DIAGN OSIS_ACCEP T | |
1261 | ;S HORT NAME: NONCOV_DX_ ACC | |
1262 | ;F ULL NAME:N ONCOVERED_ DIAGNOSIS_ ACCEPT | |
1263 | ;S YNONYMS: | |
1264 | ;D ESCRIPTION :LIST OF D IAGNOSIS T HAT ARE CO NSIDERED N ONCOVERED BUT ARE AL LOWED FOR PAYMENT WH EN THEY AR E NOT PRIM ARY IN TES T 151. | |
1265 | ; | |
1266 | ;1 54,2 | |
1267 | ;N OUN:ACNE_D IAGNOSIS_R EJECT | |
1268 | ;S HORT NAME: ACNE_DX_RE J | |
1269 | ;F ULL NAME:A CNE_DIAGNO SIS_REJECT | |
1270 | ;S YNONYMS: | |
1271 | ;D ESCRIPTION :CONTAINS A LIST OF ACNE DIAGN OSIS THAT WILL RESUL T IN A REJ ECT IN AI TEST #154 | |
1272 | ; | |
1273 | ;1 80,2 | |
1274 | ;N OUN:HUMAN_ CHORIONIC_ GONADOTROP IN_REJECT | |
1275 | ;S HORT NAME: HCG_REJ | |
1276 | ;F ULL NAME:H UMAN_CHORI ONIC_GONAD OTROPIN_RE JECT | |
1277 | ;S YNONYMS: | |
1278 | ;D ESCRIPTION :CONTAINS A LIST OD DIAGNOSIS CODES THAT REJECT WH EN BILLED FOR HCG IN AI TEST #180 | |
1279 | ; | |
1280 | ;1 82,3 | |
1281 | ;N OUN:PT_ANG IOPLASTY_A CCEPT | |
1282 | ;S HORT NAME: PTA_ACCEPT | |
1283 | ;F ULL NAME:P T_ANGIOPLA STY_ACCEPT | |
1284 | ;S YNONYMS: | |
1285 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS THAT AN BE ACCEPTED WHEN BILLE D FOR PER CUTANEOUS TRANSLUMIN AL ANGIOPL ASTY IN A I TEST #18 2 | |
1286 | ; | |
1287 | ;1 83,2 | |
1288 | ;N OUN:ACTH_A CCEPT | |
1289 | ;S HORT NAME: ACTH_ACC | |
1290 | ;F ULL NAME:A CTH_ACCEPT | |
1291 | ;S YNONYMS: | |
1292 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS THAT ARE A CCEPTED WH EN THE DUR ATION OF T REATMENT I S LESS THA N 30 DAYS IN AI TEST #183 | |
1293 | ; | |
1294 | ;2 17,6 | |
1295 | ;N OUN:SERVIC ES_HIGHEST _PAYMENT_A CCEPT | |
1296 | ;S HORT NAME: SVC_HIGHES T_PAY_ACC | |
1297 | ;F ULL NAME:S ERVICES_HI GHEST_PAYM ENT_ACCEPT | |
1298 | ;S YNONYMS: | |
1299 | ;D ESCRIPTION :CONTAINS A LIST OF SERVICES W HEN BILLED WITH OFFI CE VISTS P AY 100% HI GHEST METH OD IN AI T EST 217 | |
1300 | ; | |
1301 | ;2 22,3 | |
1302 | ;N OUN:VITAMI N_B12_ACCE PT_3 | |
1303 | ;S HORT NAME: B12_ACC_3 | |
1304 | ;F ULL NAME:V ITAMIN_B12 _ACCEPT_3 | |
1305 | ;S YNONYMS: | |
1306 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS THAT WHEN BILLED WIT H A CODE F ROM NOUN - VIT_B12_IN JECTION_AC CEPT_3, AL LOW THE B_ 12 INJECTI ON CODE TO BE ACCEPT ED IN TEST #222 | |
1307 | ; | |
1308 | ;2 22,4 | |
1309 | ;N OUN:VITAMI N_B12_ACCE PT_4 | |
1310 | ;S HORT NAME: B12_ACC_4 | |
1311 | ;F ULL NAME:V ITAMIN_B12 _ACCEPT_4 | |
1312 | ;S YNONYMS: | |
1313 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS THAT WHEN BILLED WIT H A CODE F ROM NOUN - VIT_B12_IN JECTION_AC CEPT_4, AL LOW THE B_ 12 INJECTI ON CODE TO BE ACCEPT ED IN TEST #222 | |
1314 | ; | |
1315 | ;2 35,3 | |
1316 | ;N OUN:HYPERT HERMIA_OHI _QAQ | |
1317 | ;S HORT NAME: HYPR_OHI_Q AQ | |
1318 | ;F ULL NAME:H YPERTHERMI A_OHI_QAQ | |
1319 | ;D ESCRIPTION :CONTAINS A LIST OF PROCEDURE CODES THAT WILL SET THE HYPERT HERMIA TRE ATMENT TO PAY WITH O HI OR SEND S FOR MED REVIEW W/O OHI | |
1320 | ; | |
1321 | ;2 45,4 | |
1322 | ;N OUN:BLOOD_ GLUCOSE_MO NITOR_ACCE PT | |
1323 | ;S HORT NAME: BGM_ACC | |
1324 | ;F ULL NAME:B LOOD_GLUCO SE_MONITOR _ACCEPT | |
1325 | ;S YNONYMS: | |
1326 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS THAT ARE A CCEPTED WH EN OHI IS PRESENT FO R BLOOD GL UCOSE MONI TOR IN AI TEST #245 | |
1327 | ; | |
1328 | ;2 45,5 | |
1329 | ;N OUN:BLOOD_ GLUCOSE_MO NITOR_MED_ REVIEW | |
1330 | ;S HORT NAME: BGM_MED_RE V | |
1331 | ;F ULL NAME:B LOOD_GLUCO SE_MONITOR _MED_REVIE W | |
1332 | ;S YNONYMS: | |
1333 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS THAT ARE S ENT FOR CL INICAL REV IEW WHEN B ILLED FOR BLOOD GLUC OSE MONITO R IN AI TE ST #245 | |
1334 | ; | |
1335 | ;2 70,2,3,4 | |
1336 | ;N OUN:ROUTIN E_FOOT_CAR E_100PCT_P AYMENT_MET HOD | |
1337 | ;S HORT NAME: FOOT_CARE_ 100PCT | |
1338 | ;F ULL NAME:R OUTINE_FOO T_CARE_100 PCT_PAYMEN T_METHOD | |
1339 | ;S YNONYMS: | |
1340 | ;D ESCRIPTION :CONTAINS A LIST OF FOOT CARE SERVICE CO DES THAT A LLOWED AT 100% IN RU LE TEST #2 70 | |
1341 | ; | |
1342 | ;2 85,2 | |
1343 | ;N OUN:MALE_G ENITAL_STU DIES | |
1344 | ;S HORT NAME: MALE_GNTL_ STDY | |
1345 | ;F ULL NAME:M ALE_GENITA L_STUDIES | |
1346 | ;D ESCRIPTION :CONTAINS A LIST OF PENILE STU DY PROCEDU RE CODES T HAT ARE EL IGIBLE FOR MULTIPLE SURGERY RE DUCTION. | |
1347 | ; | |
1348 | ;324,4 | |
1349 | ;NOUN:THE R_OR_DIAG_ INJ | |
1350 | ;SHORT NA ME:THER_DI AG_INJ | |
1351 | ;DESCRIPT ION:CONTAI NS A LIST OF DRUG CO DES THAT W ILL DENY P ROCEDURES 90782 AND G0351 | |
1352 | ; | |
1353 | ;324,5 | |
1354 | ;NOUN:THE R_OR_DIAG_ ORAL | |
1355 | ;SHORT NA ME:THER_OR _DIAG_ORAL | |
1356 | ;DESCRIPT ION: CONT AINS A LIS T OF ORAL DRUGS THAT WILL DENY PROCEDURE S 90782 AN D G0351 | |
1357 | ; | |
1358 | ;3 25,3,4,5,6 | |
1359 | ;N OUN:PNEUMA TIC_COMPRE SSORS_CLIN ICAL_REVIE W | |
1360 | ;S HORT NAME: PNEU_COMP_ MED_REV | |
1361 | ;F ULL NAME:P NEUMATIC_C OMPRESSORS _CLINICAL_ REVIEW | |
1362 | ;S YNONYMS: | |
1363 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS THAT SENDS PNEUMATIC COMPRESSO RS FOR CLI NICAL REVI EW IN AI T EST #325 | |
1364 | ; | |
1365 | ;3 25,7 | |
1366 | ;N OUN:PNEUMA TIC_COMPRE SSORS_REJE CT | |
1367 | ;S HORT NAME: PNEU_COMP_ REJ | |
1368 | ;F ULL NAME:P NEUMATIC_C OMPRESSORS _REJECT | |
1369 | ;S YNONYMS: | |
1370 | ;D ESCRIPTION :CONTAINS A LIST OF PNEUMATIC COMPRESSOR S CODES TH AT ARE REJ ECTED IN A I TEST #32 5 | |
1371 | ; | |
1372 | ;3 32,2 | |
1373 | ;N OUN:PHLEBO TOMY_DIAGN OSIS_ACCEP T | |
1374 | ;S HORT NAME: PHLEB_DX_A CC | |
1375 | ;F ULL NAME:P HLEBOTOMY_ DIAGNOSIS_ ACCEPT | |
1376 | ;S YNONYMS: | |
1377 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS CODES THAT CAN BE AC CEPTED WHE N BILLED O N A PHELBO TOMY CLAIM IN TEST # 332 | |
1378 | ; | |
1379 | ;3 37,2 | |
1380 | ;N OUN:SCREEN ING_PAP_10 0PCT_METHO D | |
1381 | ;S HORT NAME: PAP_100PCT _MTHD | |
1382 | ;F ULL NAME:S CREENING_P AP_100PCT_ METHOD | |
1383 | ;D ESCRIPTION :CONTAINS A LIST OF SCREENING PAP SMEAR CODES THAT ARE EXEMP T FROM A C OST-SHARE | |
1384 | ; | |
1385 | ;3 38,3 | |
1386 | ;N OUN:CHRONI C_FATIGUE_ SYNDROME | |
1387 | ;S HORT NAME: FATIGUE_SR O | |
1388 | ;FULL NAM E:CHRONIC_ FATIGUE_SY NDROME | |
1389 | ;D ESCRIPTION :CONTAINS A LIST OF CHRONIC FA TIGUE SYND ROME DXS | |
1390 | ; | |
1391 | ;3 40,2 | |
1392 | ;N OUN:RABIES _VACCINE_A CCEPT | |
1393 | ;S HORT NAME: RABIES_VAC _ACPT | |
1394 | ;F ULL NAME:R ABIES_VACC INE_ACCEPT | |
1395 | ;S YNONYMS: | |
1396 | ;D ESCRIPTION :CONTAINS A LIST OF DIAGNOSIS CODES THAT WHEN BILL ED WITH A RABIES VAC INNE ALLO W THE SERV ICE IN AI TEST #340 | |
1397 | ; | |
1398 | ;3 44,2 | |
1399 | ;N OUN:DIGITA L_MAMMOGRA M_REJECT | |
1400 | ;S HORT NAME: DIGITAL_MA MMO_REJ | |
1401 | ;F ULL NAME:D IGITAL_MAM MOGRAM_REJ ECT | |
1402 | ;S YNONYMS: | |
1403 | ;D ESCRIPTION :CONTAINS A LIST OF DIGITAL MA MMOGRAMS C ODE THAT A RE DENIED WHEN BILL WITH A DOS PRIOR TO 09/26/2001 | |
1404 | ; | |
1405 | ;3 48,2 | |
1406 | ;N OUN:MENING OCOCCAL_VA CCINE | |
1407 | ;S HORT NAME: MENICA_VAC | |
1408 | ;F ULL NAME:M ENINGOCOCC AL_VACCINE | |
1409 | ;D ESCRIPTION :CONTAINS A LIST OF MENINGOCOC CAL VACCIN E PROCEDUR E CODES | |
1410 | ; | |
1411 | ;3 48,14,15 | |
1412 | ;N OUN:HIB_PN EUMOCOCCAL _REJECT | |
1413 | ;S HORT NAME: HIB_REJECT | |
1414 | ;F ULL NAME:H IB_PNEUMOC OCCAL_REJE CT | |
1415 | ;S YNONYMS: | |
1416 | ;D ESCRIPTION :CONTAINS A LIST OF HIB PNUMOC OCCAL SERV ICES CODES THAT ARE REJECTED I F AGE IS L ESS THAN 6 WEEKS OR GREATER TH AN 5 IN AI TEST #348 | |
1417 | ; | |
1418 | ;3 51,3 | |
1419 | ;N OUN:AMBULA NCE_SUPPLI ES_REJECT | |
1420 | ;S HORT NAME: AMB_SUPPLY _REJ | |
1421 | ;F ULL NAME:A MBULANCE_S UPPLIES_RE JECT | |
1422 | ;S YNONYMS: | |
1423 | ;D ESCRIPTION :CONTAINS A LIST OF AMBULANCE SUPPLY COD ES THAT AR E REJECTED WHEN BILL ED AS OUTP ATIENT IN TEST #351 | |
1424 | ; | |
1425 | ;3 54,2,4 | |
1426 | ;N OUN:VACCIN ATIONS_ADM IN_ACCEPT | |
1427 | ;S HORT NAME: VAC_ADMIN_ ACCEPT | |
1428 | ;F ULL NAME:V ACCINATION S_ADMIN_AC CEPT | |
1429 | ;S YNONYMS: | |
1430 | ;D ESCRIPTION :CONTAINS A LIST OF IMMUNIZATI ON ADMINIS TRATION CO DES WHEN B ILLED WITH A COVERED VACCINATI ON CODE IN RULE 2 AR E ALLOWED, WHEN BILL ED WITH VA CCINATION CODES IN R ULE 4 ARE SENT FOR CLINICAL R EVIEW IN A I TEST #35 4 | |
1431 | ; | |
1432 | ;357,4 | |
1433 | ;NOUN:PRO STATE_CANC ER_HISTORY | |
1434 | ;SHORT NA ME:PRST_CN CR_HIST | |
1435 | ;FULL NAM E:PROSTATE _CANCER_HI STORY | |
1436 | ;DESCRIPT ION:CONTAI NS A LIST OF FAMILY HISTORY OF PROSTATE CANCER DXS | |
1437 | ; | |
1438 | ;357,5 | |
1439 | ;NOUN:VAS ECTOMY_STA TUS | |
1440 | ;SHORT NA ME:VASCTMY _STAT | |
1441 | ;FULL NAM E:VASECTOM Y_STATUS | |
1442 | ;DESCRIPT ION:CONTAI NS A LIST OF VASECTO MY STERILI ZATION STA TUS DXS | |
1443 | ; | |
1444 | ;E ND | |
1445 | ;E ND | |
1446 | ; | |
1447 | ; compare TE ST with AI version o f it | |
1448 | COMP(TST) ; | |
1449 | S CP="DEV 741T02" | |
1450 | S CP1="DE V741T02" | |
1451 | S CP21="D EV741T02" | |
1452 | S D1="DEV ICD" | |
1453 | S D2="DEV ICD" | |
1454 | S DFLTDIR 1="DEVICD" | |
1455 | S DFLTDIR 2="DEVICD" | |
1456 | S GLO1="^ DIC(741100 ,"_TST_")" | |
1457 | S GLO1DS= "|""DEVICD ""|" | |
1458 | S GLO1NAM =0 | |
1459 | S GLO2="^ AIR.DIC(74 1100,"_TST _")" | |
1460 | S GLO2DS= "|""DEVICD ""|" | |
1461 | S GLO2NAM =0 | |
1462 | S IO="FTA 2300:" | |
1463 | S NA="" | |
1464 | S NA1="" | |
1465 | S NA2="" | |
1466 | S NU=0 | |
1467 | S NU1=0 | |
1468 | S NU2=0 | |
1469 | S SAME=1 | |
1470 | S X=1 | |
1471 | S ZU(68,7 )=1 | |
1472 | G GO^%GCM P | |
1473 | Q | |
1474 | ; | |
1475 | RESTVARS ; | |
1476 | R !,"Clai m name: ", CN Q:CN="" | |
1477 | I '$D(^IC D10.AILOG( CN)) W !," Wrong clai m" Q | |
1478 | F ERI=1:1 Q:'$D(^IC D10.AILOG( CN,ERI)) Q:$D(^ICD1 0.AILOG(CN ,ERI,"ILOG ","VARS")) | |
1479 | I '$D(^IC D10.AILOG( CN,ERI)) W !,"No err ors" Q | |
1480 | S X=$D(^I CD10.AILOG (CN,ERI,"I LOG","VARS ")) | |
1481 | D VARSG^C HIUTIL($ZR ,99) | |
1482 | Q | |
1483 | DMELIST ; | |
1484 | ;;B9000, B9002, B90 04, B9006, E0130-E01 55, E0163, E0165, E0 168-E0171, E0175 | |
1485 | ;;E0181-E 0187, E019 3-E0199, E 0250-E0266 , E0271, E 0272, E027 7, E0290-E 0297 | |
1486 | ;;E0301-E 0310, E032 8, E0329, E0370-E037 3, E0445, E0450, EO4 60, E0461, E0463-E04 80 | |
1487 | ;;E0482-E 0484, E055 0-E0570, E 0575-E0585 , E0600, E 0601, E060 7, E0618, E0619, E06 27 | |
1488 | ;;E0630-E 0642, E072 0, E0730, E0744, E07 45, E0747- E0749, E07 60, E0762, E0776 | |
1489 | ;;E0779-E 0791, E084 0-E0856, E 0860, E087 0, E0880, E0890, E09 00, E0910- E0941 | |
1490 | ;;E0946-E 0948, E095 5-E0974, E 0985, E099 0-E1010, E 1014, E103 1-E1039, E 1050-E1093 | |
1491 | ;;E1100-E 1110, E113 0-E1161, E 1170-E1200 , E1220-E1 226, E1229 -E1270, E1 280-E1295 | |
1492 | ;;E2000, E2402, E23 00, E2301, E8000-E80 02, K0001- K0899 | |
1493 | S AIEN=99 99,RIEN=9, U="^" | |
1494 | K DD,DIC, CHMDIC | |
1495 | S GLAZDD= "^DD",GLAZ DIC="^DIC" ,GLAZCHM=" ^CHMDIC" | |
1496 | S FILENUM =741112.04 _AIEN_RIEN | |
1497 | S FILENAM ="CHAMPVA AIFD DME P ROCEDURE L IST" | |
1498 | S NOUNNAM ="DME PROC EDURE LIST " | |
1499 | S LST=$$M KNNEW(FILE NUM,.FILEN AM,NOUNNAM ) Q:'LST | |
1500 | S @GLAZCH M@(LST,0)= "" | |
1501 | ; populat e new list | |
1502 | S I=0 | |
1503 | F LN=1:1: 9 S TXT=$P ($T(DMELIS T+LN),";;" ,2) F P=1: 1:$L(TXT," ,") D | |
1504 | . S PCSL= $TR($P(TXT ,",",P)," ") | |
1505 | . S PCBEG =$P(PCSL," -"),PCEND= $S(PCSL["- ":$P(PCSL, "-",2),1:P CSL) | |
1506 | . S PC=$O (^CHMSERV( "B",PCBEG) ,-1) | |
1507 | . F S PC =$O(^CHMSE RV("B",PC) ) Q:PC]PCE ND D | |
1508 | . . S CHM DIC(FILENU M,$I(I),0) =PC | |
1509 | . . S CHM DIC(FILENU M,"B",PC,I )="" | |
1510 | S CHMDIC( FILENUM,0) =FILENAM_U _FILENUM_U _(I-1)_U_( I-1) | |
1511 | M @GLAZDD =DD | |
1512 | M @GLAZDI C=DIC | |
1513 | M @GLAZCH M=CHMDIC | |
1514 | Q | |
1515 | HIST ; | |
1516 | ;^DD(7411 00.004,.01 ,0)="INCLU DE HISTORY NOUNS^MS^ | |
1517 | ;1:Family Fiscal Ye ar Procedu re History | |
1518 | ;2:Family Fiscal Ye ar Mental Health Pro cedure His tory | |
1519 | ;3:Benefi ciary Same Day Proce dures | |
1520 | ;4:Benefi ciary Prio r Year Pro cedure His tory | |
1521 | ; | |
1522 | ; (1) | |
1523 | ;^DIC(741 100.01,261 ,0)="SUBST ANCE_ABUSE _PROC_COUN T^SAPC^SA_ PROCS_CNT" | |
1524 | ;^DIC(741 100.01,265 ,0)="FAMIL Y_THERAPY_ PROCEDURE_ COUNT^FTPC ^FT_PROC_C NT" | |
1525 | ; (2) | |
1526 | ;^DIC(741 100.01,116 ,0)="MHPC^ MH_PROC_CN T^MENTAL_H EALTH_PROC EDURE_COUN T" | |
1527 | ; (3) | |
1528 | ;^DIC(741 100.01,29, 0)="OTHER_ DIAGNOSES_ SAME_DAY^O THER_DIAGN OSIS_SAME_ DAY^OTHER_ DIAGNOSES_ SAME_DAY" | |
1529 | ;^DIC(741 100.01,41, 0)="OTHER_ LOCATIONS_ SAME_DAY^O LSD^OTHER_ LOCATIONS_ SAME_DAY" | |
1530 | ;^DIC(741 100.01,43, 0)="OTHER_ PROCEDURES _SAME_VISI T^OPCSV^OT HER_PROCED URES_SAME_ VISIT" | |
1531 | ;^DIC(741 100.01,44, 0)="OTHER_ PROVIDERS_ SAME_DAY^O PVSD^OTHER _PROVIDERS _SAME_DAY" | |
1532 | ;^DIC(741 100.01,62, 0)="SAME_P ROC_SAME_D AY^SAME_PR C_SAME_DAY ^SAME_PROC _SAME_DAY" | |
1533 | ;^DIC(741 100.01,63, 0)="PROC_D AY^PROC_DA Y^PROCEDUR ES_SAME_DA Y" | |
1534 | ;^DIC(741 100.01,73, 0)="NUMBER _PROC_SAME _PROV_DAY^ NUM_PROC_S AME_PROV_D AY^NUMBER_ PROC_SAME_ PROV_SAME_ DAY" | |
1535 | ;^DIC(741 100.01,74, 0)="OTHER_ PROC_SAME_ DAY^OPSD^O THER_PROCE DURES_SAME _DAY" | |
1536 | ;^DIC(741 100.01,80, 0)="NUMBER _PROC_SAME _DAY^NPSD^ NUMBER_SAM E_PROCEDUR E_SAME_DAY " | |
1537 | ;^DIC(741 100.01,89, 0)="NUM_PR OC_SAME_DA Y_SAME_PRO V^NPSDSP^N UMBER_PROC _SAME_DAY_ SAME_PROV" | |
1538 | ;^DIC(741 100.01,90, 0)="NUMBER _OTH_PROC_ SAME_DAY^N OPSD^NUMBE R_OTHER_PR OC_SAME_DA Y" | |
1539 | ;^DIC(741 100.01,102 ,0)="OTHER _CLAIMS_SA ME_DAY^OCL SD^OTHER_C LAIMS_SAME _DAY" | |
1540 | ; (4) | |
1541 | ;^DIC(741 100.01,96, 0)="PROC_Y R_PRIOR^PC YP^PROCEDU RES_YEAR_P RIOR" | |
1542 | ;^DIC(741 100.01,97, 0)="NUM_PR OC_YEAR_PR IOR^NPYP^N UMBER_PROC EDURES_YEA R_PRIOR" | |
1543 | K HISTN | |
1544 | D SETACT | |
1545 | F A="SA_P ROCS_CNT", "FT_PROC_C NT" D | |
1546 | . S HISTN ($O(^DIC(7 41100.01," B",A,""))) =1 | |
1547 | F A="MENT AL_HEALTH_ PROCEDURE_ COUNT" D | |
1548 | . S HISTN ($O(^DIC(7 41100.01," B",A,""))) =2 | |
1549 | F A="OTHE R_DIAGNOSE S_SAME_DAY ","OTHER_L OCATIONS_S AME_DAY"," OTHER_PROC EDURES_SAM E_VISIT" D | |
1550 | . S HISTN ($O(^DIC(7 41100.01," B",A,""))) =3 | |
1551 | F A="OTHE R_PROVIDER S_SAME_DAY ","SAME_PR OC_SAME_DA Y","PROCED URES_SAME_ DAY" D | |
1552 | . S HISTN ($O(^DIC(7 41100.01," B",A,""))) =3 | |
1553 | F A="NUMB ER_PROC_SA ME_PROV_SA ME_DAY","O THER_PROCE DURES_SAME _DAY","NUM BER_SAME_P ROCEDURE_S AME_DAY" D | |
1554 | . S HISTN ($O(^DIC(7 41100.01," B",A,""))) =3 | |
1555 | F A="NUMB ER_PROC_SA ME_DAY_SAM E_PROV","N UMBER_OTHE R_PROC_SAM E_DAY","OT HER_CLAIMS _SAME_DAY" D | |
1556 | . S HISTN ($O(^DIC(7 41100.01," B",A,""))) =3 | |
1557 | F A="PROC EDURES_YEA R_PRIOR"," NUMBER_PRO CEDURES_YE AR_PRIOR" D | |
1558 | . S HISTN ($O(^DIC(7 41100.01," B",A,""))) =4 | |
1559 | S I=0 F S I=$O(^DI C(741100,I )) Q:'I K ^DIC(7411 00,I,4) | |
1560 | S A="^DIC (741100)" | |
1561 | F S A=$Q (@A) Q:A'? 1"^DIC(741 100,".E D | |
1562 | . S TIEN= $P(A,",",2 )+0 | |
1563 | . Q:'$D(A CTIVE(TIEN )) | |
1564 | . S EL=@A _"^" | |
1565 | . I EL'[" $n" Q | |
1566 | . S N="" F S N=$O( HISTN(N)) Q:N="" I EL[("$n"_N _"^") D | |
1567 | . . Q:$D( ^DIC(74110 0,TIEN,4," B",HISTN(N ))) | |
1568 | . . S HIE N=$O(^DIC( 741100,TIE N,4,"A"),- 1)+1 | |
1569 | . . S ^DI C(741100,T IEN,4,HIEN ,0)=HISTN( N) | |
1570 | . . S ^DI C(741100,T IEN,4,"B", HISTN(N),H IEN)="" | |
1571 | . . S $P( ^DIC(74110 0,TIEN,4,0 ),"^",2)=7 41100.004 | |
1572 | . . S $P( ^DIC(74110 0,TIEN,4,0 ),"^",3)=H IEN | |
1573 | . . S $P( ^DIC(74110 0,TIEN,4,0 ),"^",4)=$ P(^DIC(741 100,TIEN,4 ,0),"^",4) +1 | |
1574 | Q | |
1575 | ; | |
1576 | //D OBJ^C HICDAI("CH AIR.HACAI. sch.champv aClaim",0) | |
1577 | OBJ(OBJ,IN D) ; | |
1578 | N PRO,PRO T,PROL | |
1579 | S PRO="" | |
1580 | ;W !,$J(" ",IND),OBJ ,"--->" | |
1581 | F S PRO= $O(^oddDEF (OBJ,"a",P RO)) Q:PRO ="" D | |
1582 | . S PROT= ^oddDEF(OB J,"a",PRO, 5) | |
1583 | . S PROL= $G(^oddDEF (OBJ,"a",P RO,27)) | |
1584 | . I $P(PR OT,".")'=$ P(OBJ,".") W !,$J("" ,IND),PRO, " As " W:P ROL="list" "list of " W PROT Q | |
1585 | F S PRO= $O(^oddDEF (OBJ,"a",P RO)) Q:PRO ="" D | |
1586 | . S PROT= ^oddDEF(OB J,"a",PRO, 5) | |
1587 | . S PROL= $G(^oddDEF (OBJ,"a",P RO,27)) | |
1588 | . I $P(PR OT,".")'=$ P(OBJ,".") Q | |
1589 | . W !,$J( "",IND),PR O," As " W :PROL="lis t" "list o f " W PROT | |
1590 | . D OBJ(P ROT,IND+5) | |
1591 | Q | |
1592 | CR25 ;Add AI tests # 525-#650 | |
1593 | D NOW^%DT C S DT=X | |
1594 | F AITN=52 5:1:650 D | |
1595 | . S AITNA ME="TEST # "_AITN | |
1596 | . I $D(^D IC(741100, "B",AITNAM E)) W !,"A I test ",A ITNAME," i s already defined" Q | |
1597 | . S AITIE N=$O(^DIC( 741100,"%" ),-1)+1 | |
1598 | . S ^DIC( 741100,AIT IEN,0)=AIT NAME_"^^^7 41100.03^7 41100.01^7 41100.02^7 41100.04^^ ^"_DT_"^^C T" | |
1599 | . S ^DIC( 741100,AIT IEN,3)="35 0*351*363" | |
1600 | . S ^DIC( 741100,AIT IEN,101,0) ="^^1^1^"_ DT | |
1601 | . S ^DIC( 741100,AIT IEN,101,1, 0)="Placeh older AI t est" | |
1602 | . S ^DIC( 741100,"B" ,AITNAME,A ITIEN)="" | |
1603 | . S $P(^D IC(741100, 0),"^",3)= AITIEN | |
1604 | . S $P(^D IC(741100, 0),"^",4)= $P(^DIC(74 1100,0),"^ ",4)+1 | |
1605 | . W !,"AI test ",AI TNAME," ad ded as IEN ",AITIEN | |
1606 | Q | |
1607 | CR24 ; Cha nge field names from LAST ELEM ENT to LAS T RULE PRI ORITY | |
1608 | ;^DD(7410 00.0203,.0 7,0)="LAST ELEMENT^F ^^0;6^K:$L (X)>7!($L( X)<1) X" | |
1609 | ;^DD(7410 00.0205,.0 6,0)="LAST ELEMENT^F ^^0;6^K:$L (X)>7!($L( X)<1) X" | |
1610 | ;^DD(7410 00.06,.06, 0)="LAST E LEMENT^F^^ 0;6^K:$L(X )>5!($L(X) <1) X" | |
1611 | ;^DD(7413 001.0203,. 07,0)="LAS T ELEMENT^ F^^0;6^K:$ L(X)>7!($L (X)<1) X" | |
1612 | ;^DD(7413 001.0205,. 06,0)="LAS T ELEMENT^ F^^0;6^K:$ L(X)>7!($L (X)<1) X" | |
1613 | ;^DD(7413 001.06,.06 ,0)="LAST ELEMENT^F^ ^0;6^K:$L( X)>5!($L(X )<1) X" | |
1614 | F FILE=74 1000.0203, 741000.020 5,741000.0 6,7413001. 0203,74130 01.0205,74 13001.06 D | |
1615 | . S FIELD =$S(FILE[" 0203":.07, 1:.06) | |
1616 | . S DDZ=^ DD(FILE,FI ELD,0) | |
1617 | . I $P(DD Z,"^")'="L AST ELEMEN T" Q | |
1618 | . K ^DD(F ILE,"B",$P (DDZ,"^")) | |
1619 | . S ^DD(F ILE,"B","L AST RULE P RIORITY",F IELD)="" | |
1620 | . S $P(^D D(FILE,FIE LD,0),"^") ="LAST RUL E PRIORITY " | |
1621 | Q | |
1622 | MDQ ; | |
1623 | ; Modifie d copy of: | |
1624 | ; CHBPF94 ;CVA/JEH; REMOVE CLA IMS IN THE MDQ;01/02 /93 11:41 AM | |
1625 | ;V1.0 | |
1626 | I $G(DUZ) ="" S DUZ= 9944 | |
1627 | I $T(STAT INP^CHTFLI BC)="" W ! ,"DEV02122 4 is not i nstalled. Please in stall befo re continu ing" Q | |
1628 | W !,"Plea se note th at if you don't sele ct time, i t will be assumed to be midnig ht of sele cted day", ! | |
1629 | S %DT="AE PT",%DT("A ")="Select starting Date/Time: " D ^%DT | |
1630 | I Y'?7N.1 ".".6N W ! ,"Invalid starting D ate/Time" Q | |
1631 | S STARTDT =Y | |
1632 | S %DT="AE PT",%DT("A ")="Select ending Da te/Time: " D ^%DT | |
1633 | I Y'?7N.1 ".".6N W ! ,"Invalid ending Dat e/Time" Q | |
1634 | S ENDDT=Y | |
1635 | W !,"Rele asing AI e rrors clai ms from MD Q",! | |
1636 | S IDT=STARTD T,CTR=0 | |
1637 | F S IDT=$O( ^CHMMDQ("D ",0,IDT)) Q:'IDT Q: IDT>ENDDT D ; | |
1638 | . S MDQI=0 | |
1639 | . F S MDQI= $O(^CHMMDQ ("D",0,IDT ,MDQI)) Q: 'MDQI D | |
1640 | . . S REC =$G(^CHMMD Q(MDQI,0)) | |
1641 | . . I $P( REC,"^",3) '=0 Q ; make s ure still pending | |
1642 | . . I $P( REC,"^",6) '=0 Q ; make s ure it is due to bad AI | |
1643 | . . S CI=$P( REC,"^",2) | |
1644 | . . S CTR=CT R+1 | |
1645 | . . S CLNM=$ P(^CHMPAY( CI,0),"^") | |
1646 | . . S Y=IDT D DD^%DT | |
1647 | . . ; comple te claims should not be in MDQ anyway, b ut check | |
1648 | . . I $P($G( ^CHMPAY(CI ,0)),"^",2 )=4 Q | |
1649 | . . S PDII=$ O(^CHMPAY( CI,"PDI",0 )) Q:'PDII | |
1650 | . . S CHMFPD I=$P(^CHMP AY(CI,"PDI ",PDII,0), "^") Q:'CH MFPDI | |
1651 | . . W !,CTR, ")",?8,"MD Q = ",MDQI ," @ ",Y," CLAIM = ",CI," (", CLNM,")" | |
1652 | . . S X1=CI D PROGTYP^ CHFCD001 | |
1653 | . . K DIE,DA ,DR | |
1654 | . . S DIE =741010.11 ,DA=MDQI,D R=".03//// 2;.04////9 944" D ^DI E | |
1655 | . . K DIE ,DA,DR | |
1656 | . . K CHE LQFLG | |
1657 | . . S CHM QNAM="CHMM DQ(",CHMOU T="" K CHM IN D ^CHMI S041 ; Q UEUE UPDAT ES TO IN/O UT REPORT | |
1658 | . . D STA TINP^CHTFL IBC(CI) ;s ets claim status to IN PROGRES S | |
1659 | . . D REV CCD^CHTFLI BC(CI) ;r everse & c lear ded/c .s./cat ca p from cla im | |
1660 | . . D CONENDE^CH TFLIBC(CI) ;kill ONE node of ^ CHMPAY but retain OH I & INPATI ENT data | |
1661 | . . D CREJREA^CH TFLIBC(CI) ;kill rej ect reason node | |
1662 | . . D CCDTREJ^CH TFLIBC(CI) ;clear co mpl. date & claim re j. reason | |
1663 | . . D CCOMMON^CH TFLIBC(CI) ;clear ca lculated d ata in com mon node | |
1664 | . . D CUNITS^CHT FLIBC(CI) ;clear ou t calculat ed data at unit leve l | |
1665 | . . D KRULE^CHTF LIBC(CI) ;kill RUL E nodes fo r reproces sing | |
1666 | . . D CREOPFL^CH TFLIBC(CI) ;clear re open calcu lation fla g | |
1667 | . . K CHMFCLMS,C HMFRS ; CLEAN OUT ARRAY | |
1668 | . . S CHMFCL MS(CLNM)=C I,CHMFRS(C LNM)="",CH ELQFLG="" | |
1669 | . . D WORKFL 3^CHFCDUTL ; Update workflow | |
1670 | . . ;S CH MFCLMS(CLN M)=CL,CHRS TSRT=1,CHR EOPN=1 | |
1671 | . . D ^CH FCDDRV | |
1672 | . . ;D QUE2^ CHFCDUTL ; Submiss ion queued for check data and benefit ca lc | |
1673 | W !,"DONE PR OCESSING C LAIMS IN M DQ..." | |
1674 | W !!,"TOT AL NUMBER OF CLAIMS REMOVED FR OM MISSING DATA QUEU E: ",CTR | |
1675 | K IDT,MDQI,C TR,REC,CL, CLNM | |
1676 | Q | |
1677 | RUNNOUN ; | |
1678 | ; needs C I | |
1679 | D NOW^%DT C | |
1680 | I $G(CI)= "" R !,"Cl aim: ",CI S CI=$O(^C HMPAY("B", CI,"")) | |
1681 | I $G(CI)= "" R !,"Cl aim IEN: " ,CI | |
1682 | I $G(GLPA Y)="" S X1 =CI D PROG TYP^CHFCD0 01 | |
1683 | R !,"0:DR G 1:DIAGN OSIS 2:PR OCEDURE 3:PHARMACY : ",CHMFC T | |
1684 | I CHMFCT= 0 S CHMFJP =1 | |
1685 | E W !,"I EN of ",$C ASE(CHMFCT ,0:"DRG",1 :"DIAGNOSI S",2:"PROC EDURE",3:" PHARMACY") R CHMFJP | |
1686 | S NM=CHMF JP | |
1687 | R !,"Noun : ",NNAME Q:NNAME="" S NNAME= $TR(NNAME, " ","_") | |
1688 | S NOUN=$O (^DIC(7411 00.01,"B", NNAME,"")) | |
1689 | I NOUN="" W !,"Not Found" Q | |
1690 | S NOUNX=$ P($G(^DIC( 741100.01, NOUN,1))," ^",3,4) | |
1691 | K Y D @NO UNX | |
1692 | W !,"Resu lt is :",! ZW Y | |
1693 | Q | |
1694 | WKFLOW(CI) ; | |
1695 | W !,"CLAI M WORKFLOW " | |
1696 | I '$D(^CHMPA Y(CI)) W ! ,"Claim Wo rkflow doe s not exis t for this claim, OR it has be en archive d." Q | |
1697 | W "CLAIM NUM BER - "_$P ($G(^CHMPA Y(CI,0))," ^") | |
1698 | S CHWFPTR=0 | |
1699 | F S CHWF PTR=$O(^CH MPAYW(CI,2 ,CHWFPTR)) Q:'CHWFPT R D | |
1700 | . S REC=$G(^ CHMPAYW(CI ,2,CHWFPTR ,0)) Q:REC ="" | |
1701 | . S PT=$P(RE C,"^",1) Q :'$D(^CHMD IC(741002. 25,PT,0)) | |
1702 | . S NM=$TR($ P(^CHMDIC( 741002.25, PT,0),"^", 1,2),"^"," /") | |
1703 | . S ZPA1=$P( REC,"^",2) | |
1704 | . S CHFWDT=$ $FMTE^XLFD T(ZPA1,1) | |
1705 | . S ZPA4=$P( REC,"^",3) I ZPA4="" S CHFWDUZ ="UNKNOWN" G ENWK | |
1706 | . I '$D(^VA( 200,ZPA4,0 )) S CHFWD UZ="UNKNOW N" G ENWK | |
1707 | . S CHFWDUZ= $P(^VA(200 ,ZPA4,0)," ^",1) | |
1708 | ENWK . W ! ,CHFWDT_" -- "_CHF WDUZ | |
1709 | . W !," "_ PT_" - "_N M | |
1710 | Q | |
1711 | INITSUBD ; | |
1712 | S IEN=0,S UBAI=$O(^D IC(741100, "B","TEST #215","")) | |
1713 | F S IEN= $O(^CHMSER V(IEN)) Q: 'IEN D | |
1714 | . I $P($G (^CHMSERV( IEN,0)),"^ ",9)'=1 Q | |
1715 | . S CVA=$ P($G(^CHMS ERV(IEN,10 2,1,0)),"^ ",2) | |
1716 | . S SB=$P ($G(^CHMSE RV(IEN,102 ,6,0)),"^" ,2) | |
1717 | . ; if al ready assi gned to ne eded test, skip | |
1718 | . I CVA=S UBAI,SB=SU BAI Q | |
1719 | . ; if al ready assi gned to so me other t est, tell user and s kip. | |
1720 | . ;I CVA' ="",SB'="" W !,IEN," ",CVA," " ,SB," PCS already as signed to ",CVA,"/", SB,", skip ping" Q | |
1721 | . F PE=1, 6,7 D | |
1722 | . . S CUR R=$G(^CHMS ERV(IEN,10 2,PE,0)) | |
1723 | . . S ^CH MSERV(IEN, 102,PE,0)= PE_"^"_SUB AI_"^9921^ 3150129" | |
1724 | . . S ^CH MSERV(IEN, 102,"B",PE ,PE)="" | |
1725 | . . ; Upd ate histor y | |
1726 | . . I CUR R="" Q | |
1727 | . . S HIS T=$O(^CHMS ERV(IEN,10 2,PE,101," B"),-1)+1 | |
1728 | . . S ^CH MSERV(IEN, 102,PE,101 ,HIST,0)=C URR | |
1729 | . . ; B x ref at 101 history l evel is co rrupted an d useless. Don't bo ther setti ng it. | |
1730 | . . S ^CH MSERV(IEN, 102,PE,101 ,0)="^7410 06.102101P ^"_HIST_"^ "_HIST | |
1731 | . S ^CHMS ERV(IEN,10 2,0)="^741 006.0102P^ 7^3" | |
1732 | . Q | |
1733 | S IEN=0,S UBAI=$O(^D IC(741100, "B","TEST #153","")) | |
1734 | F S IEN= $O(^CHMICD X(IEN)) Q: 'IEN D | |
1735 | . I $P($G (^CHMICDX( IEN,0)),"^ ",16)'=1 Q | |
1736 | . S CVA=$ P($G(^CHMI CDX(IEN,10 2,1,0)),"^ ",2) | |
1737 | . S SB=$P ($G(^CHMIC DX(IEN,102 ,6,0)),"^" ,2) | |
1738 | . ; if al ready assi gned to ne eded test, skip | |
1739 | . I CVA=S UBAI,SB=SU BAI Q | |
1740 | . ; if al ready assi gned to so me other t est, tell user and s kip. | |
1741 | . ;I CVA' ="",SB'="" W !,IEN," ",CVA," " ,SB," DX a lready ass igned to " ,CVA,"/",S B,", skipp ing" Q | |
1742 | . F PE=1, 6,7 D | |
1743 | . . S CUR R=$G(^CHMI CDX(IEN,10 2,PE,0)) | |
1744 | . . S ^CH MICDX(IEN, 102,PE,0)= PE_"^"_SUB AI_"^9921^ 3150129" | |
1745 | . . S ^CH MICDX(IEN, 102,"B",PE ,PE)="" | |
1746 | . . ; Upd ate histor y | |
1747 | . . I CUR R="" Q | |
1748 | . . S HIS T=$O(^CHMI CDX(IEN,10 2,PE,101," B"),-1)+1 | |
1749 | . . S ^CH MICDX(IEN, 102,PE,101 ,HIST,0)=C URR | |
1750 | . . ; B x ref at 101 history l evel is co rrupted an d useless. Don't bo ther setti ng it. | |
1751 | . . S ^CH MICDX(IEN, 102,PE,101 ,0)="^7410 06.0510210 1P^"_HIST_ "^"_HIST | |
1752 | . S ^CHMI CDX(IEN,10 2,0)="^741 006.05102P ^7^3" | |
1753 | . ;W !,IE N," BLANK DX" | |
1754 | . Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.