1 | SCMSVUT2 ;ALB/JLU;Utility routine for AMBCARE;06/28/99
|
---|
2 | ;;5.3;Scheduling;**66,180,254,293,325,466,521**;AUG 13,1993;Build 1
|
---|
3 | ;06/28/99 ACS Added CPT modifier validation
|
---|
4 | ;
|
---|
5 | COUNT(VALER) ;counts the number of errored encounters found.
|
---|
6 | ;INPUT VALER - The array containing the errors.
|
---|
7 | ;OUTPUT the number of errors
|
---|
8 | ;
|
---|
9 | N VAR,CNT
|
---|
10 | S VAR="",CNT=0
|
---|
11 | F S VAR=$O(@VALER@(VAR)) Q:VAR']"" S CNT=CNT+1
|
---|
12 | Q CNT
|
---|
13 | ;
|
---|
14 | IPERR(VALER) ;counts the number of inpatient errored encounters found.
|
---|
15 | ;INPUT VALER - The array containing the errors.
|
---|
16 | ;OUTPUT the number of errors
|
---|
17 | ;
|
---|
18 | N VAR,CNT
|
---|
19 | S VAR="",CNT=0
|
---|
20 | F S VAR=$O(@VALER@(VAR)) Q:VAR']"" D
|
---|
21 | .I $$INPATENC^SCDXUTL(VAR) S CNT=CNT+1
|
---|
22 | Q CNT
|
---|
23 | ;
|
---|
24 | FILEVERR(PTR,VALERR) ;files the errors found for an encounter
|
---|
25 | ;INPUT PTR - The pointer to the entry in the transmission file 409.73
|
---|
26 | ; VALERR - The array holding the errors for the encounter.
|
---|
27 | ;OUTPUT 0 - did not file
|
---|
28 | ; 1 - did file
|
---|
29 | N SEG,FILE
|
---|
30 | I '$D(VALERR) Q 0
|
---|
31 | S SEG="",FILE=-1
|
---|
32 | F S SEG=$O(@VALERR@(SEG)) Q:SEG']"" D FILE(VALERR,SEG,PTR,.FILE)
|
---|
33 | Q $S(FILE=1:1,1:0)
|
---|
34 | ;
|
---|
35 | FILE(VALERR,SEG,PTR,FILE) ;
|
---|
36 | N NBR
|
---|
37 | S NBR=0
|
---|
38 | F S NBR=$O(@VALERR@(SEG,NBR)) Q:'NBR DO
|
---|
39 | .N CODPTR,CODE
|
---|
40 | .S CODE=$G(@VALERR@(SEG,NBR))
|
---|
41 | .I CODE']"" Q
|
---|
42 | .S CODPTR=$O(^SD(409.76,"B",CODE,""))
|
---|
43 | .I 'CODPTR Q
|
---|
44 | .I $D(^SD(409.75,"AER",PTR,CODPTR)) S FILE=1 Q
|
---|
45 | .S FILE=$$CRTERR^SCDXFU02(PTR,CODE)
|
---|
46 | .Q
|
---|
47 | Q
|
---|
48 | ;
|
---|
49 | VALWL(CLIN) ;WORKLOAD VALIDATION AT CHECK OUT
|
---|
50 | ;INPUT CLIN - IEN OF CLINIC
|
---|
51 | ;OUTPUT 0 - DO NOT VALIDATE WORKLOAD
|
---|
52 | ; 1 - VALIDATE CLINIC WORKLOAD
|
---|
53 | N A1
|
---|
54 | I '$D(CLIN) S CLIN=0
|
---|
55 | S A1=$P($G(^SC(+CLIN,0)),U,30)
|
---|
56 | Q $S(A1=1:1,1:0)
|
---|
57 | ;
|
---|
58 | VALIDATE(XMITPTR) ;validates data that has a entry in the transmit file.
|
---|
59 | ;
|
---|
60 | ;INPUT XMITPTR - This is the point to an entry in file 409.73.
|
---|
61 | ;
|
---|
62 | ;OUTPUT -1 - the was a problem with the inputs
|
---|
63 | ; 0 - no errors were found
|
---|
64 | ; 1 - errors were found
|
---|
65 | ;
|
---|
66 | N VALERR,ERR,HL,HLEID,DFN
|
---|
67 | S ANS=-1
|
---|
68 | S XMITPTR=+$G(XMITPTR)
|
---|
69 | I $G(^SD(409.73,XMITPTR,0))']"" G VALQ
|
---|
70 | D PATDFN^SCDXUTL2(XMITPTR)
|
---|
71 | ;
|
---|
72 | S HL7XMIT="^TMP(""HLS"","_$J_")",VALERR="^TMP(""SCDXVALID"","_$J_","_XMITPTR_")"
|
---|
73 | ;Initialze HL7 variables
|
---|
74 | S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
|
---|
75 | I ('HLEID) G VALQ
|
---|
76 | D INIT^HLFNC2(HLEID,.HL)
|
---|
77 | I ($O(HL(""))="") G VALQ
|
---|
78 | ;
|
---|
79 | S ERR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,1,HL7XMIT,1,VALERR)
|
---|
80 | ;
|
---|
81 | I ERR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
|
---|
82 | S ANS=0
|
---|
83 | D DELAERR^SCDXFU02(XMITPTR,0)
|
---|
84 | D DEMUPDT(DFN,VALERR,"DEMO")
|
---|
85 | I $O(@VALERR@(0))]"" DO
|
---|
86 | .N FILE
|
---|
87 | .S ANS=1
|
---|
88 | .S FILE=$$FILEVERR(XMITPTR,VALERR)
|
---|
89 | .Q
|
---|
90 | ;
|
---|
91 | K @VALERR,@HL7XMIT
|
---|
92 | ;
|
---|
93 | VALQ Q ANS
|
---|
94 | ;
|
---|
95 | DEMUPDT(DFN,VALERR,TYP) ;
|
---|
96 | ;This entry point updates all the other encoutners for this patient
|
---|
97 | ;that HAVE errors with a new set or demographic errors or deletes all
|
---|
98 | ;the demographic errors if none were found.
|
---|
99 | ;INPUT DFN - The patient's DFN
|
---|
100 | ; VALERR - errors to log
|
---|
101 | ; TYP - The type of errors to delete and log.
|
---|
102 | ; Right now demographic errors are the only kind "DEMO"
|
---|
103 | ;
|
---|
104 | S DFN=$G(DFN),TYP=$G(TYP),VALERR=$G(VALERR)
|
---|
105 | I DFN=""!(TYP="")!(VALERR="") Q
|
---|
106 | N PTRS,RNG,LP,PTR
|
---|
107 | S RNG=$P($T(@(TYP)),";;",2),PTRS=""
|
---|
108 | D CLEAN(DFN,RNG,.PTRS)
|
---|
109 | I '$D(@VALERR@("PID")) Q
|
---|
110 | I PTRS']"" Q
|
---|
111 | F LP=1:1 S PTR=$P(PTRS,U,LP) Q:PTR']"" DO
|
---|
112 | .I '$D(^SD(409.73,PTR,0)) Q
|
---|
113 | .N FILE
|
---|
114 | .D FILE(VALERR,"PID",PTR,.FILE)
|
---|
115 | .Q
|
---|
116 | Q
|
---|
117 | ;
|
---|
118 | CLEAN(DFN,RNG,PTRS) ;This subroutine cleans out all errors for a pateint
|
---|
119 | ;and returns a string of which entries in 409.73 were cleaned of errors
|
---|
120 | ;
|
---|
121 | N LP,COD,LP2,IEN
|
---|
122 | F LP=1:1 S COD=$P(RNG,U,LP) Q:COD']"" I $D(^SD(409.75,"ACOD",DFN,COD)) S IEN="" F LP2=1:1 S IEN=$O(^SD(409.75,"ACOD",DFN,COD,IEN)) Q:IEN']"" DO
|
---|
123 | .N VAR,RES
|
---|
124 | .S VAR=$P($G(^SD(409.75,IEN,0)),U,1)_"^"
|
---|
125 | .I $P(VAR,U,1)="" S PTR="" Q
|
---|
126 | .S RES=$$DELERR^SCDXFU02(IEN)
|
---|
127 | .I PTRS[VAR Q
|
---|
128 | .S PTRS=PTRS_VAR
|
---|
129 | .Q
|
---|
130 | Q
|
---|
131 | ;
|
---|
132 | MODCODE(DATA,ENCDT) ;
|
---|
133 | ;
|
---|
134 | ;---------------------------------------------------------------
|
---|
135 | ; VALIDATE MODIFIER AND CPT+MODIFIER COMBINATION
|
---|
136 | ;
|
---|
137 | ; INPUT: DATA - The procedure and modifier code to be checked
|
---|
138 | ; format: CPT~modifier
|
---|
139 | ; ENCDT - The date of the encounter
|
---|
140 | ;
|
---|
141 | ;OUTPUT: 1 - valid modifier and CPT+modifier combination
|
---|
142 | ; 0 - invalid modifier or CPT+modifier combination
|
---|
143 | ;
|
---|
144 | ;**NOTE** This call makes the assumption that leading zeros are
|
---|
145 | ; intact in the input.
|
---|
146 | ;---------------------------------------------------------------
|
---|
147 | ;
|
---|
148 | ;- validate modifier only
|
---|
149 | N DATAMOD
|
---|
150 | S DATAMOD=$P(DATA,"~",2)
|
---|
151 | I '$D(DATAMOD) Q 0
|
---|
152 | I $$MOD^ICPTMOD(DATAMOD,"E",ENCDT,1)'>0 Q 0
|
---|
153 | ;
|
---|
154 | ;- validate CPT+modifier pair
|
---|
155 | N DATAPROC
|
---|
156 | S DATAPROC=$P(DATA,"~",1)
|
---|
157 | I '$D(DATAPROC) Q 0
|
---|
158 | I $$MODP^ICPTMOD(DATAPROC,DATAMOD,"E",ENCDT,1)'>0 Q 0
|
---|
159 | Q 1
|
---|
160 | ;
|
---|
161 | MODMETH(DATA) ;
|
---|
162 | ;
|
---|
163 | ;---------------------------------------------------------------
|
---|
164 | ; VALIDATE MODIFIER CODING METHOD
|
---|
165 | ;
|
---|
166 | ; INPUT: DATA - The modifier coding method to be checked
|
---|
167 | ;
|
---|
168 | ;OUTPUT: 1 - valid modifier coding method
|
---|
169 | ; 0 - invalid modifier coding method
|
---|
170 | ;
|
---|
171 | ; Valid modifier coding methods: C and H
|
---|
172 | ;---------------------------------------------------------------
|
---|
173 | ;
|
---|
174 | I '$D(DATA) Q 0
|
---|
175 | S DATA=","_DATA_","
|
---|
176 | I ",C,H,"'[DATA Q 0
|
---|
177 | Q 1
|
---|
178 | ;
|
---|
179 | ETHNIC(DATA) ;
|
---|
180 | ;INPUT DATA - the ethnicity code to be validated (NNNN-C-XXX)
|
---|
181 | ;
|
---|
182 | N VAL,MTHD
|
---|
183 | I '$D(DATA) Q 0
|
---|
184 | I DATA="" Q 1
|
---|
185 | S VAL=$P(DATA,"-",1,2)
|
---|
186 | S MTHD=$P(DATA,"-",3)
|
---|
187 | I VAL'?4N1"-"1N Q 0
|
---|
188 | I ",SLF,UNK,PRX,OBS,"'[MTHD Q 0
|
---|
189 | Q 1
|
---|
190 | CONFDT(DATA,SUB) ;CONFIDENTIAL ADDRESS START/STOP DATE
|
---|
191 | N X,Y,%DT,DTOUT,STDT,ENDT
|
---|
192 | I '$D(DATA) Q 0
|
---|
193 | S STDT=$P(DATA,SUB,1)
|
---|
194 | S ENDT=$P(DATA,SUB,2)
|
---|
195 | I STDT="" Q 0
|
---|
196 | S STDT=$$FMDATE^HLFNC(STDT)
|
---|
197 | S X=STDT,%DT="X" D ^%DT I Y=-1 Q 0 ;SD/521 added %DT
|
---|
198 | I ENDT="" Q 1
|
---|
199 | S ENDT=$$FMDATE^HLFNC(ENDT)
|
---|
200 | S X=ENDT,%DT="X" D ^%DT I Y=-1 Q 0 ;SD/521 added %DT
|
---|
201 | I $$FMDIFF^XLFDT(ENDT,STDT,1)<0 Q 0
|
---|
202 | Q 1
|
---|
203 | ;
|
---|
204 | CONFCAT(DATA) ;CONFIDENTIAL ADDRESS CATEGORY TYPE
|
---|
205 | I '$D(DATA) Q 0
|
---|
206 | I DATA="" Q 0
|
---|
207 | N VAL,GOOD
|
---|
208 | S GOOD=0
|
---|
209 | F VAL="VACAA","VACAC","VACAE","VACAM","VACAO" I DATA=VAL S GOOD=1 Q
|
---|
210 | Q GOOD
|
---|
211 | ;
|
---|
212 | CVEDT(DATA) ;Combat vet end date (ZEL.38)
|
---|
213 | ;Input : DATA - CombatVetIndicator ^ CombatVetEndDate
|
---|
214 | ;Output : 1 = Good / 0 = Bad
|
---|
215 | ;
|
---|
216 | N CVI,CVEDT
|
---|
217 | S DATA=$G(DATA)
|
---|
218 | S CVI=$P(DATA,"^",1)
|
---|
219 | S CVEDT=$P(DATA,"^",2)
|
---|
220 | I 'CVI Q $S(CVEDT="":1,1:0)
|
---|
221 | Q CVEDT?8N
|
---|
222 | ;
|
---|
223 | CLCV(DATA,SDOE) ;Cross check for combat vet classification question
|
---|
224 | ;Input : DATA - Answer to classification question
|
---|
225 | ; SDOE - Pointer to encounter (file # 409.68)
|
---|
226 | ;Output : 1 = Good / 0 = Bad
|
---|
227 | ;
|
---|
228 | S DATA=$G(DATA)
|
---|
229 | Q:(DATA'=1) 1
|
---|
230 | N VET,SDDT,SDOE0
|
---|
231 | S SDOE=$G(SDOE) Q:'SDOE 0
|
---|
232 | S SDOE0=$G(^SCE(SDOE,0))
|
---|
233 | S SDDT=+SDOE0 Q:'SDDT 0
|
---|
234 | S DFN=+$P(SDOE0,"^",2) Q:'DFN 0
|
---|
235 | S VET=$P($$EL^SDCO22(DFN,SDOE),"^",5)
|
---|
236 | I VET'="Y" Q 0
|
---|
237 | S VET=+$$CVEDT^DGCV(DFN,SDDT)
|
---|
238 | Q $S(VET=1:1,1:0)
|
---|
239 | ;
|
---|
240 | DEMO ;;2000^2030^2050^2100^2150^2200^2210^2220^2230^2240^2250^2300^2330^2360
|
---|