| 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 | 
|---|