| [623] | 1 | SCMSVUT2 ;ALB/JLU;Utility routine for AMBCARE;06/28/99
 | 
|---|
 | 2 |  ;;5.3;Scheduling;**66,180,254,293,325,466**;AUG 13,1993;Build 2
 | 
|---|
 | 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 D ^%DT I Y=-1 Q 0
 | 
|---|
 | 198 |  I ENDT="" Q 1
 | 
|---|
 | 199 |  S ENDT=$$FMDATE^HLFNC(ENDT)
 | 
|---|
 | 200 |  S X=ENDT D ^%DT I Y=-1 Q 0
 | 
|---|
 | 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
 | 
|---|