source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMSVUT2.m@ 1203

Last change on this file since 1203 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.6 KB
Line 
1SCMSVUT2 ;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 ;
5COUNT(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 ;
14IPERR(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 ;
24FILEVERR(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 ;
35FILE(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 ;
49VALWL(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 ;
58VALIDATE(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 ;
93VALQ Q ANS
94 ;
95DEMUPDT(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 ;
118CLEAN(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 ;
132MODCODE(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 ;
161MODMETH(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 ;
179ETHNIC(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
190CONFDT(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 ;
204CONFCAT(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 ;
212CVEDT(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 ;
223CLCV(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 ;
240DEMO ;;2000^2030^2050^2100^2150^2200^2210^2220^2230^2240^2250^2300^2330^2360
Note: See TracBrowser for help on using the repository browser.