SCMSVUT2 ;ALB/JLU;Utility routine for AMBCARE;06/28/99
;;5.3;Scheduling;**66,180,254,293,325,466,521**;AUG 13,1993;Build 1
;06/28/99 ACS Added CPT modifier validation
;
COUNT(VALER) ;counts the number of errored encounters found.
;INPUT VALER - The array containing the errors.
;OUTPUT the number of errors
;
N VAR,CNT
S VAR="",CNT=0
F S VAR=$O(@VALER@(VAR)) Q:VAR']"" S CNT=CNT+1
Q CNT
;
IPERR(VALER) ;counts the number of inpatient errored encounters found.
;INPUT VALER - The array containing the errors.
;OUTPUT the number of errors
;
N VAR,CNT
S VAR="",CNT=0
F S VAR=$O(@VALER@(VAR)) Q:VAR']"" D
.I $$INPATENC^SCDXUTL(VAR) S CNT=CNT+1
Q CNT
;
FILEVERR(PTR,VALERR) ;files the errors found for an encounter
;INPUT PTR - The pointer to the entry in the transmission file 409.73
; VALERR - The array holding the errors for the encounter.
;OUTPUT 0 - did not file
; 1 - did file
N SEG,FILE
I '$D(VALERR) Q 0
S SEG="",FILE=-1
F S SEG=$O(@VALERR@(SEG)) Q:SEG']"" D FILE(VALERR,SEG,PTR,.FILE)
Q $S(FILE=1:1,1:0)
;
FILE(VALERR,SEG,PTR,FILE) ;
N NBR
S NBR=0
F S NBR=$O(@VALERR@(SEG,NBR)) Q:'NBR DO
.N CODPTR,CODE
.S CODE=$G(@VALERR@(SEG,NBR))
.I CODE']"" Q
.S CODPTR=$O(^SD(409.76,"B",CODE,""))
.I 'CODPTR Q
.I $D(^SD(409.75,"AER",PTR,CODPTR)) S FILE=1 Q
.S FILE=$$CRTERR^SCDXFU02(PTR,CODE)
.Q
Q
;
VALWL(CLIN) ;WORKLOAD VALIDATION AT CHECK OUT
;INPUT CLIN - IEN OF CLINIC
;OUTPUT 0 - DO NOT VALIDATE WORKLOAD
; 1 - VALIDATE CLINIC WORKLOAD
N A1
I '$D(CLIN) S CLIN=0
S A1=$P($G(^SC(+CLIN,0)),U,30)
Q $S(A1=1:1,1:0)
;
VALIDATE(XMITPTR) ;validates data that has a entry in the transmit file.
;
;INPUT XMITPTR - This is the point to an entry in file 409.73.
;
;OUTPUT -1 - the was a problem with the inputs
; 0 - no errors were found
; 1 - errors were found
;
N VALERR,ERR,HL,HLEID,DFN
S ANS=-1
S XMITPTR=+$G(XMITPTR)
I $G(^SD(409.73,XMITPTR,0))']"" G VALQ
D PATDFN^SCDXUTL2(XMITPTR)
;
S HL7XMIT="^TMP(""HLS"","_$J_")",VALERR="^TMP(""SCDXVALID"","_$J_","_XMITPTR_")"
;Initialze HL7 variables
S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
I ('HLEID) G VALQ
D INIT^HLFNC2(HLEID,.HL)
I ($O(HL(""))="") G VALQ
;
S ERR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,1,HL7XMIT,1,VALERR)
;
I ERR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
S ANS=0
D DELAERR^SCDXFU02(XMITPTR,0)
D DEMUPDT(DFN,VALERR,"DEMO")
I $O(@VALERR@(0))]"" DO
.N FILE
.S ANS=1
.S FILE=$$FILEVERR(XMITPTR,VALERR)
.Q
;
K @VALERR,@HL7XMIT
;
VALQ Q ANS
;
DEMUPDT(DFN,VALERR,TYP) ;
;This entry point updates all the other encoutners for this patient
;that HAVE errors with a new set or demographic errors or deletes all
;the demographic errors if none were found.
;INPUT DFN - The patient's DFN
; VALERR - errors to log
; TYP - The type of errors to delete and log.
; Right now demographic errors are the only kind "DEMO"
;
S DFN=$G(DFN),TYP=$G(TYP),VALERR=$G(VALERR)
I DFN=""!(TYP="")!(VALERR="") Q
N PTRS,RNG,LP,PTR
S RNG=$P($T(@(TYP)),";;",2),PTRS=""
D CLEAN(DFN,RNG,.PTRS)
I '$D(@VALERR@("PID")) Q
I PTRS']"" Q
F LP=1:1 S PTR=$P(PTRS,U,LP) Q:PTR']"" DO
.I '$D(^SD(409.73,PTR,0)) Q
.N FILE
.D FILE(VALERR,"PID",PTR,.FILE)
.Q
Q
;
CLEAN(DFN,RNG,PTRS) ;This subroutine cleans out all errors for a pateint
;and returns a string of which entries in 409.73 were cleaned of errors
;
N LP,COD,LP2,IEN
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
.N VAR,RES
.S VAR=$P($G(^SD(409.75,IEN,0)),U,1)_"^"
.I $P(VAR,U,1)="" S PTR="" Q
.S RES=$$DELERR^SCDXFU02(IEN)
.I PTRS[VAR Q
.S PTRS=PTRS_VAR
.Q
Q
;
MODCODE(DATA,ENCDT) ;
;
;---------------------------------------------------------------
; VALIDATE MODIFIER AND CPT+MODIFIER COMBINATION
;
; INPUT: DATA - The procedure and modifier code to be checked
; format: CPT~modifier
; ENCDT - The date of the encounter
;
;OUTPUT: 1 - valid modifier and CPT+modifier combination
; 0 - invalid modifier or CPT+modifier combination
;
;**NOTE** This call makes the assumption that leading zeros are
; intact in the input.
;---------------------------------------------------------------
;
;- validate modifier only
N DATAMOD
S DATAMOD=$P(DATA,"~",2)
I '$D(DATAMOD) Q 0
I $$MOD^ICPTMOD(DATAMOD,"E",ENCDT,1)'>0 Q 0
;
;- validate CPT+modifier pair
N DATAPROC
S DATAPROC=$P(DATA,"~",1)
I '$D(DATAPROC) Q 0
I $$MODP^ICPTMOD(DATAPROC,DATAMOD,"E",ENCDT,1)'>0 Q 0
Q 1
;
MODMETH(DATA) ;
;
;---------------------------------------------------------------
; VALIDATE MODIFIER CODING METHOD
;
; INPUT: DATA - The modifier coding method to be checked
;
;OUTPUT: 1 - valid modifier coding method
; 0 - invalid modifier coding method
;
; Valid modifier coding methods: C and H
;---------------------------------------------------------------
;
I '$D(DATA) Q 0
S DATA=","_DATA_","
I ",C,H,"'[DATA Q 0
Q 1
;
ETHNIC(DATA) ;
;INPUT DATA - the ethnicity code to be validated (NNNN-C-XXX)
;
N VAL,MTHD
I '$D(DATA) Q 0
I DATA="" Q 1
S VAL=$P(DATA,"-",1,2)
S MTHD=$P(DATA,"-",3)
I VAL'?4N1"-"1N Q 0
I ",SLF,UNK,PRX,OBS,"'[MTHD Q 0
Q 1
CONFDT(DATA,SUB) ;CONFIDENTIAL ADDRESS START/STOP DATE
N X,Y,%DT,DTOUT,STDT,ENDT
I '$D(DATA) Q 0
S STDT=$P(DATA,SUB,1)
S ENDT=$P(DATA,SUB,2)
I STDT="" Q 0
S STDT=$$FMDATE^HLFNC(STDT)
S X=STDT,%DT="X" D ^%DT I Y=-1 Q 0 ;SD/521 added %DT
I ENDT="" Q 1
S ENDT=$$FMDATE^HLFNC(ENDT)
S X=ENDT,%DT="X" D ^%DT I Y=-1 Q 0 ;SD/521 added %DT
I $$FMDIFF^XLFDT(ENDT,STDT,1)<0 Q 0
Q 1
;
CONFCAT(DATA) ;CONFIDENTIAL ADDRESS CATEGORY TYPE
I '$D(DATA) Q 0
I DATA="" Q 0
N VAL,GOOD
S GOOD=0
F VAL="VACAA","VACAC","VACAE","VACAM","VACAO" I DATA=VAL S GOOD=1 Q
Q GOOD
;
CVEDT(DATA) ;Combat vet end date (ZEL.38)
;Input : DATA - CombatVetIndicator ^ CombatVetEndDate
;Output : 1 = Good / 0 = Bad
;
N CVI,CVEDT
S DATA=$G(DATA)
S CVI=$P(DATA,"^",1)
S CVEDT=$P(DATA,"^",2)
I 'CVI Q $S(CVEDT="":1,1:0)
Q CVEDT?8N
;
CLCV(DATA,SDOE) ;Cross check for combat vet classification question
;Input : DATA - Answer to classification question
; SDOE - Pointer to encounter (file # 409.68)
;Output : 1 = Good / 0 = Bad
;
S DATA=$G(DATA)
Q:(DATA'=1) 1
N VET,SDDT,SDOE0
S SDOE=$G(SDOE) Q:'SDOE 0
S SDOE0=$G(^SCE(SDOE,0))
S SDDT=+SDOE0 Q:'SDDT 0
S DFN=+$P(SDOE0,"^",2) Q:'DFN 0
S VET=$P($$EL^SDCO22(DFN,SDOE),"^",5)
I VET'="Y" Q 0
S VET=+$$CVEDT^DGCV(DFN,SDDT)
Q $S(VET=1:1,1:0)
;
DEMO ;;2000^2030^2050^2100^2150^2200^2210^2220^2230^2240^2250^2300^2330^2360
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSVUT2 6978 printed Dec 13, 2024@02:42:09 Page 2
SCMSVUT2 ;ALB/JLU;Utility routine for AMBCARE;06/28/99
+1 ;;5.3;Scheduling;**66,180,254,293,325,466,521**;AUG 13,1993;Build 1
+2 ;06/28/99 ACS Added CPT modifier validation
+3 ;
COUNT(VALER) ;counts the number of errored encounters found.
+1 ;INPUT VALER - The array containing the errors.
+2 ;OUTPUT the number of errors
+3 ;
+4 NEW VAR,CNT
+5 SET VAR=""
SET CNT=0
+6 FOR
SET VAR=$ORDER(@VALER@(VAR))
if VAR']""
QUIT
SET CNT=CNT+1
+7 QUIT CNT
+8 ;
IPERR(VALER) ;counts the number of inpatient errored encounters found.
+1 ;INPUT VALER - The array containing the errors.
+2 ;OUTPUT the number of errors
+3 ;
+4 NEW VAR,CNT
+5 SET VAR=""
SET CNT=0
+6 FOR
SET VAR=$ORDER(@VALER@(VAR))
if VAR']""
QUIT
Begin DoDot:1
+7 IF $$INPATENC^SCDXUTL(VAR)
SET CNT=CNT+1
End DoDot:1
+8 QUIT CNT
+9 ;
FILEVERR(PTR,VALERR) ;files the errors found for an encounter
+1 ;INPUT PTR - The pointer to the entry in the transmission file 409.73
+2 ; VALERR - The array holding the errors for the encounter.
+3 ;OUTPUT 0 - did not file
+4 ; 1 - did file
+5 NEW SEG,FILE
+6 IF '$DATA(VALERR)
QUIT 0
+7 SET SEG=""
SET FILE=-1
+8 FOR
SET SEG=$ORDER(@VALERR@(SEG))
if SEG']""
QUIT
DO FILE(VALERR,SEG,PTR,.FILE)
+9 QUIT $SELECT(FILE=1:1,1:0)
+10 ;
FILE(VALERR,SEG,PTR,FILE) ;
+1 NEW NBR
+2 SET NBR=0
+3 FOR
SET NBR=$ORDER(@VALERR@(SEG,NBR))
if 'NBR
QUIT
Begin DoDot:1
+4 NEW CODPTR,CODE
+5 SET CODE=$GET(@VALERR@(SEG,NBR))
+6 IF CODE']""
QUIT
+7 SET CODPTR=$ORDER(^SD(409.76,"B",CODE,""))
+8 IF 'CODPTR
QUIT
+9 IF $DATA(^SD(409.75,"AER",PTR,CODPTR))
SET FILE=1
QUIT
+10 SET FILE=$$CRTERR^SCDXFU02(PTR,CODE)
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
VALWL(CLIN) ;WORKLOAD VALIDATION AT CHECK OUT
+1 ;INPUT CLIN - IEN OF CLINIC
+2 ;OUTPUT 0 - DO NOT VALIDATE WORKLOAD
+3 ; 1 - VALIDATE CLINIC WORKLOAD
+4 NEW A1
+5 IF '$DATA(CLIN)
SET CLIN=0
+6 SET A1=$PIECE($GET(^SC(+CLIN,0)),U,30)
+7 QUIT $SELECT(A1=1:1,1:0)
+8 ;
VALIDATE(XMITPTR) ;validates data that has a entry in the transmit file.
+1 ;
+2 ;INPUT XMITPTR - This is the point to an entry in file 409.73.
+3 ;
+4 ;OUTPUT -1 - the was a problem with the inputs
+5 ; 0 - no errors were found
+6 ; 1 - errors were found
+7 ;
+8 NEW VALERR,ERR,HL,HLEID,DFN
+9 SET ANS=-1
+10 SET XMITPTR=+$GET(XMITPTR)
+11 IF $GET(^SD(409.73,XMITPTR,0))']""
GOTO VALQ
+12 DO PATDFN^SCDXUTL2(XMITPTR)
+13 ;
+14 SET HL7XMIT="^TMP(""HLS"","_$JOB_")"
SET VALERR="^TMP(""SCDXVALID"","_$JOB_","_XMITPTR_")"
+15 ;Initialze HL7 variables
+16 SET HLEID=+$ORDER(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
+17 IF ('HLEID)
GOTO VALQ
+18 DO INIT^HLFNC2(HLEID,.HL)
+19 IF ($ORDER(HL(""))="")
GOTO VALQ
+20 ;
+21 SET ERR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,1,HL7XMIT,1,VALERR)
+22 ;
+23 IF ERR<0
IF $ORDER(@VALERR@(0))']""
DO VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
+24 SET ANS=0
+25 DO DELAERR^SCDXFU02(XMITPTR,0)
+26 DO DEMUPDT(DFN,VALERR,"DEMO")
+27 IF $ORDER(@VALERR@(0))]""
Begin DoDot:1
+28 NEW FILE
+29 SET ANS=1
+30 SET FILE=$$FILEVERR(XMITPTR,VALERR)
+31 QUIT
End DoDot:1
+32 ;
+33 KILL @VALERR,@HL7XMIT
+34 ;
VALQ QUIT ANS
+1 ;
DEMUPDT(DFN,VALERR,TYP) ;
+1 ;This entry point updates all the other encoutners for this patient
+2 ;that HAVE errors with a new set or demographic errors or deletes all
+3 ;the demographic errors if none were found.
+4 ;INPUT DFN - The patient's DFN
+5 ; VALERR - errors to log
+6 ; TYP - The type of errors to delete and log.
+7 ; Right now demographic errors are the only kind "DEMO"
+8 ;
+9 SET DFN=$GET(DFN)
SET TYP=$GET(TYP)
SET VALERR=$GET(VALERR)
+10 IF DFN=""!(TYP="")!(VALERR="")
QUIT
+11 NEW PTRS,RNG,LP,PTR
+12 SET RNG=$PIECE($TEXT(@(TYP)),";;",2)
SET PTRS=""
+13 DO CLEAN(DFN,RNG,.PTRS)
+14 IF '$DATA(@VALERR@("PID"))
QUIT
+15 IF PTRS']""
QUIT
+16 FOR LP=1:1
SET PTR=$PIECE(PTRS,U,LP)
if PTR']""
QUIT
Begin DoDot:1
+17 IF '$DATA(^SD(409.73,PTR,0))
QUIT
+18 NEW FILE
+19 DO FILE(VALERR,"PID",PTR,.FILE)
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
CLEAN(DFN,RNG,PTRS) ;This subroutine cleans out all errors for a pateint
+1 ;and returns a string of which entries in 409.73 were cleaned of errors
+2 ;
+3 NEW LP,COD,LP2,IEN
+4 FOR LP=1:1
SET COD=$PIECE(RNG,U,LP)
if COD']""
QUIT
IF $DATA(^SD(409.75,"ACOD",DFN,COD))
SET IEN=""
FOR LP2=1:1
SET IEN=$ORDER(^SD(409.75,"ACOD",DFN,COD,IEN))
if IEN']""
QUIT
Begin DoDot:1
+5 NEW VAR,RES
+6 SET VAR=$PIECE($GET(^SD(409.75,IEN,0)),U,1)_"^"
+7 IF $PIECE(VAR,U,1)=""
SET PTR=""
QUIT
+8 SET RES=$$DELERR^SCDXFU02(IEN)
+9 IF PTRS[VAR
QUIT
+10 SET PTRS=PTRS_VAR
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
MODCODE(DATA,ENCDT) ;
+1 ;
+2 ;---------------------------------------------------------------
+3 ; VALIDATE MODIFIER AND CPT+MODIFIER COMBINATION
+4 ;
+5 ; INPUT: DATA - The procedure and modifier code to be checked
+6 ; format: CPT~modifier
+7 ; ENCDT - The date of the encounter
+8 ;
+9 ;OUTPUT: 1 - valid modifier and CPT+modifier combination
+10 ; 0 - invalid modifier or CPT+modifier combination
+11 ;
+12 ;**NOTE** This call makes the assumption that leading zeros are
+13 ; intact in the input.
+14 ;---------------------------------------------------------------
+15 ;
+16 ;- validate modifier only
+17 NEW DATAMOD
+18 SET DATAMOD=$PIECE(DATA,"~",2)
+19 IF '$DATA(DATAMOD)
QUIT 0
+20 IF $$MOD^ICPTMOD(DATAMOD,"E",ENCDT,1)'>0
QUIT 0
+21 ;
+22 ;- validate CPT+modifier pair
+23 NEW DATAPROC
+24 SET DATAPROC=$PIECE(DATA,"~",1)
+25 IF '$DATA(DATAPROC)
QUIT 0
+26 IF $$MODP^ICPTMOD(DATAPROC,DATAMOD,"E",ENCDT,1)'>0
QUIT 0
+27 QUIT 1
+28 ;
MODMETH(DATA) ;
+1 ;
+2 ;---------------------------------------------------------------
+3 ; VALIDATE MODIFIER CODING METHOD
+4 ;
+5 ; INPUT: DATA - The modifier coding method to be checked
+6 ;
+7 ;OUTPUT: 1 - valid modifier coding method
+8 ; 0 - invalid modifier coding method
+9 ;
+10 ; Valid modifier coding methods: C and H
+11 ;---------------------------------------------------------------
+12 ;
+13 IF '$DATA(DATA)
QUIT 0
+14 SET DATA=","_DATA_","
+15 IF ",C,H,"'[DATA
QUIT 0
+16 QUIT 1
+17 ;
ETHNIC(DATA) ;
+1 ;INPUT DATA - the ethnicity code to be validated (NNNN-C-XXX)
+2 ;
+3 NEW VAL,MTHD
+4 IF '$DATA(DATA)
QUIT 0
+5 IF DATA=""
QUIT 1
+6 SET VAL=$PIECE(DATA,"-",1,2)
+7 SET MTHD=$PIECE(DATA,"-",3)
+8 IF VAL'?4N1"-"1N
QUIT 0
+9 IF ",SLF,UNK,PRX,OBS,"'[MTHD
QUIT 0
+10 QUIT 1
CONFDT(DATA,SUB) ;CONFIDENTIAL ADDRESS START/STOP DATE
+1 NEW X,Y,%DT,DTOUT,STDT,ENDT
+2 IF '$DATA(DATA)
QUIT 0
+3 SET STDT=$PIECE(DATA,SUB,1)
+4 SET ENDT=$PIECE(DATA,SUB,2)
+5 IF STDT=""
QUIT 0
+6 SET STDT=$$FMDATE^HLFNC(STDT)
+7 ;SD/521 added %DT
SET X=STDT
SET %DT="X"
DO ^%DT
IF Y=-1
QUIT 0
+8 IF ENDT=""
QUIT 1
+9 SET ENDT=$$FMDATE^HLFNC(ENDT)
+10 ;SD/521 added %DT
SET X=ENDT
SET %DT="X"
DO ^%DT
IF Y=-1
QUIT 0
+11 IF $$FMDIFF^XLFDT(ENDT,STDT,1)<0
QUIT 0
+12 QUIT 1
+13 ;
CONFCAT(DATA) ;CONFIDENTIAL ADDRESS CATEGORY TYPE
+1 IF '$DATA(DATA)
QUIT 0
+2 IF DATA=""
QUIT 0
+3 NEW VAL,GOOD
+4 SET GOOD=0
+5 FOR VAL="VACAA","VACAC","VACAE","VACAM","VACAO"
IF DATA=VAL
SET GOOD=1
QUIT
+6 QUIT GOOD
+7 ;
CVEDT(DATA) ;Combat vet end date (ZEL.38)
+1 ;Input : DATA - CombatVetIndicator ^ CombatVetEndDate
+2 ;Output : 1 = Good / 0 = Bad
+3 ;
+4 NEW CVI,CVEDT
+5 SET DATA=$GET(DATA)
+6 SET CVI=$PIECE(DATA,"^",1)
+7 SET CVEDT=$PIECE(DATA,"^",2)
+8 IF 'CVI
QUIT $SELECT(CVEDT="":1,1:0)
+9 QUIT CVEDT?8N
+10 ;
CLCV(DATA,SDOE) ;Cross check for combat vet classification question
+1 ;Input : DATA - Answer to classification question
+2 ; SDOE - Pointer to encounter (file # 409.68)
+3 ;Output : 1 = Good / 0 = Bad
+4 ;
+5 SET DATA=$GET(DATA)
+6 if (DATA'=1)
QUIT 1
+7 NEW VET,SDDT,SDOE0
+8 SET SDOE=$GET(SDOE)
if 'SDOE
QUIT 0
+9 SET SDOE0=$GET(^SCE(SDOE,0))
+10 SET SDDT=+SDOE0
if 'SDDT
QUIT 0
+11 SET DFN=+$PIECE(SDOE0,"^",2)
if 'DFN
QUIT 0
+12 SET VET=$PIECE($$EL^SDCO22(DFN,SDOE),"^",5)
+13 IF VET'="Y"
QUIT 0
+14 SET VET=+$$CVEDT^DGCV(DFN,SDDT)
+15 QUIT $SELECT(VET=1:1,1:0)
+16 ;
DEMO ;;2000^2030^2050^2100^2150^2200^2210^2220^2230^2240^2250^2300^2330^2360
