SCMSVUT1 ;ALB/JLU;validation utility routine;06/19/99 ; 4/30/03 11:58am
;;5.3;Scheduling;**66,143,180,239,247,258,296,295,321,341,387,459,394,442,1015**;AUG 13,1993;Build 21
;06/19/99 ACS - Added CPT Modifier API calls to PROCCOD(DATA)
;
SEGERR(DATA,HLFS) ;
;INPUT DATA - This is a check for the segment errors of null
; HLFS - The string separator character
I '$D(DATA) Q 0
I DATA="" Q 0
I $L(DATA,HLFS)'>2 Q 0
Q 1
;
DODA(DATA) ;
;INPUT DATA - The FM date of death.
;
I '$D(DATA) Q 0
I DATA="" Q 1
N %DT,X,Y
S %DT="T",%DT(0)="-NOW",X=DATA
D ^%DT
Q $S(Y=-1:0,1:1)
;
DODB(DATA,ENCDT) ;
;INPUT DATA - The FM date of death
; ENCDT - The FM date of encounter
I '$D(DATA) Q 0
I DATA="" Q 1
N %DT,X,Y
S %DT="T",%DT(0)=ENCDT,X=DATA
D ^%DT
Q $S(Y=-1:0,1:1)
;
DODL(DATA,ENCDT) ;
;INPUT DATA - The FM date of death
; ENCDT - The FM date of the encounter
I '$D(DATA) Q 0
I '$D(ENCDT) Q 0
I DATA="" Q 1
I ENCDT<DATA Q 1
I ENCDT=DATA Q 1
N X1,X2,X
S X1=ENCDT,X2=DATA
D ^%DTC
I X>14 Q 0
Q 1
;
HOME(DATA) ;
;INPUT DATA - THe homeless indicator to be validated.
;
I '$D(DATA) Q 0
I DATA'=1,DATA'=0 Q 0
Q 1
;
POW(DATA) ;
;INPUT DATA - The POW indicatort to be validated.
;
I '$D(DATA) Q 0
I DATA="" Q 1
I DATA'="N",DATA'="U",DATA'="Y" Q 0
Q 1
;
TYPINS(DATA) ;
;INPUT DATA - Type if insurance indicator to be validated.
;
I '$D(DATA) Q 0
I DATA="" Q 1
I DATA?.A Q 0
I DATA>-1,(DATA<13) Q 1
Q 0
;
PATCLSS(DATA) ;
;INPUT DATA - the patient's class
;
I '$D(DATA) Q 0
I ("^O^I^")'[("^"_DATA_"^") Q 0
Q 1
;
POV(DATA) ;
;
;INPUT DATA - the purpose of visit.
;SD*5.3*394 - Correction for addition POV.
;
N VAR
I '$D(DATA) Q 0
I $L(DATA)'=4 Q 0
I DATA?.A Q 0
S VAR=$E(DATA,1,2)
I VAR<1!(VAR>4) Q 0
S VAR=$E(DATA,3,4)
I VAR<1!(VAR=10) Q 0
Q 1
;
COMPGEN(DATA) ;
;INPUT DATA - checking computer generated.
;
N VAR
S VAR=$E(DATA,3,4)
I VAR=10 Q 0
Q 1
;
LOCVIS(DATA) ;
;INPUT DATA - Location of visit
;
I DATA'=1,DATA'=6 Q 0
Q 1
;
FACNMBR(DATA) ;
;INPUT DATA - The facility number
;
I '$D(DATA) Q 0
I DATA'?3N.AN Q 0
I '$D(^DIC(4,"D",DATA)) Q 0
Q 1
;
FACACT(DATA,ENCDT,DIV) ;
;INPUT DATA - The active flag of the facility number.
;
I '$D(DATA) Q 0
I '$D(ENCDT) Q 0
I '$D(DIV) Q 0
I DATA="" Q 0
N SITE
I DIV]"" S SITE=$$SITE^VASITE(ENCDT,DIV)
I DIV']"" S SITE=$$SITE^VASITE(ENCDT)
I DATA'=$P(SITE,U,3) Q 0
Q 1
;
ENCDT(DATA,XMTFLG) ;
;INPUT DATA - The date/time of the encounter
; XMTFLG - Flag to check $$OKTOXMIT^SCDXFU04(DATA)
;
I '$D(DATA) Q 0
S XMTFLG=$G(XMTFLG,0)
N %DT,X,Y
S %DT="T"
S X=DATA
D ^%DT
I Y=-1 Q 0
I XMTFLG Q 1
N VAR
S VAR=$$OKTOXMIT^SCDXFU04(DATA)
I +VAR<4&(VAR'<0) Q 1 ;SD*5.3*247
Q 0
;
UNIQNMBR(DATA) ;
;INPUT DATA - The unique number from PCE for the encounter
;
I '$D(DATA) Q 0
I DATA="" Q 0
I DATA=-1 Q 0
I DATA=0 Q 0
Q 1
;
SEGCHK(DATA,HLFS) ;
;INPUT DATA - The segment to be checked.
; HLFS - The HL7 field separator
;
I '$D(DATA) Q 0
I DATA="" Q 0
I $L(DATA,HLFS)'>2 Q 0
Q 1
;
SEQNBR(DATA,SEQNBR) ;
;INPUT DATA - The sequence number to be checked.
; SEQNBR - This is the previous seq number to compare to
;
I '$D(DATA) Q 0
I DATA="" Q 0
I +DATA'=+SEQNBR Q 0
S SEQNBR=SEQNBR+1
Q 1
;
DCODMTHD(DATA) ;
;INPUT DATA - This is the coding method to be checked.
;
I '$D(DATA) Q 0
I DATA'="I9" Q 0
Q 1
;
DIAGCOD(DATA,ENCDT) ;
;INPUT DATA - This is the diagnosis code
; ENCDT - This is the encounter date
;
N VAR
I '$D(DATA) Q 0
I DATA="" Q 0
;
Q $P($$ICDDX^ICDCODE(DATA,ENCDT),"^",10)
;
PRIOR(DATA) ;
;INPUT DATA - The priority of the diagnosis found
;
I '$D(DATA) Q 0
I DATA="" Q 1
I DATA=1 Q 1
Q 0
;
ELIGCODM(DATA) ;
;INPUT DATA - The eligibility code
;A CHECK FOR MISSING
I '$D(DATA) Q 0
I DATA="" Q 0
I '$D(^DIC(8.1,DATA,0)) Q 0
Q 1
;
ELIGINCV(DATA) ;
;INPUT DATA - Contains the eligibility code in the first piece and
;the veteran status in the second.
;
;the following quit is to stop this edit check.
;Per Austin 9/97 this is not needed.
Q 1
N VET,ELIG
S VET=$P(DATA,U,2)
S ELIG=$P(DATA,U,1)
I VET=1&((ELIG<1)!(ELIG>18)) Q 0
I VET=1,ELIG>5,ELIG<15 Q 0
I VET=0,ELIG<6 Q 0
I VET=0,ELIG=11 Q 0
I VET=0,ELIG>14,ELIG'=19 Q 0
Q 1
;
ELIGINCS(DATA) ;
;INPUT DATA - Eligibility code
;
I '$D(DATA) Q 0
I DATA="" Q 0
I '$D(^DIC(8.1,DATA,0)) Q 0
I +$P(^DIC(8.1,DATA,0),U,7) Q 0
Q 1
;
VETSTAT(DATA) ;
;INPUT DATA - The veteran status indicator
;
I '$D(DATA) Q 0
I DATA'=0,DATA'=1 Q 0
Q 1
;
VETPOW(DATA,DFN) ;
;INPUT DATA - veteran status to check with POW status.
; DFN - The DFN of the patient.
;
N VAR,POW
I DATA=0 Q 1
S VAR=$G(^DPT(DFN,.52))
S POW=$S(VAR]"":$P(VAR,U,5),1:VAR)
I POW="" Q 1
I POW="Y"!(POW="N")!(POW="U") Q 1
Q 0
;
NMBRDEP(DATA) ;
;INPUT DATA - the number of dependents
;
I '$D(DATA) Q 0
I DATA="" Q 0
I DATA="XX" Q 1
I DATA'?1.2N Q 0
I +DATA>99!(+DATA<0) Q 0
Q 1
;
PATINC(DATA) ;
;INPUT DATA - The patient's income
;
I '$D(DATA) Q 0
I DATA="" Q 0
I DATA<0 Q 0
I DATA'?.N.1".".N Q 0
Q 1
;
MEANSTST(DATA) ;
;INPUT DATA - The means test indicator
;
I '$D(DATA) Q 0
S DATA=","_DATA_","
; ** SD*296, added 'U' means test indicator to allowed list.
I ",AS,AN,N,X,C,G,U,"'[DATA Q 0
Q 1
;
DEPMEANS(DATA) ;
;INPUT DATA - This variable contains the number of dependents in the
; first peice and the means test indicator in the second.
;
N MT,DEP
I '$D(DATA) Q 0
S DEP=$P(DATA,U,1)
S MT=","_$P(DATA,U,2)_","
I DEP="XX",(",AS,N,X,U,"'[MT) Q 0
Q 1
;
CLASSQUE(DATA) ;
;INPUT DATA - Classification question value.
;
I '$D(DATA) Q 0
I DATA'=1,DATA'=0,DATA'="" Q 0
Q 1
;
CLAQUETY(DATA) ;
;INPUT DATA - Outpatient classification type to be checked.
;
I '$D(DATA) Q 0
I DATA="" Q 0
I '$D(^SD(409.41,DATA,0)) Q 0
Q 1
;
CLAVET(DATA,DFN,TYPE,ENCPTR) ; SD*5.3*341 added parameter ENCPTR
;INPUT DATA - Classification question information to compare to VET
; status
; DFN - The patient to compare this info to.
; TYPE - The classification type.
; ENCPTR - Pointer to Outpatient Encounter
;
I '$D(DATA) Q 0
I '$D(DFN) Q 0
I '$D(TYPE) Q 0 ; SD*5.3*341
N VET,SDELG0,SDDT ; SD*5.3*341
S ENCPTR=$G(ENCPTR) ; SD*5.3*341 added this plus next 3 lines
S SDDT=+$G(^SCE(ENCPTR,0)) S:'SDDT SDDT=$$DT^XLFDT()
S SDELG0=$$EL^SDCO22(DFN,ENCPTR)
S VET=$P(SDELG0,U,5)
I VET="Y",DATA'=1,DATA'=0,DATA'="" Q 0
;This edit check is per a mail message from austin
I TYPE=4,VET'="Y",DATA'="","^A^B^C^D^"'[("^"_($P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3))_"^") Q 0
I VET'="Y",DATA'="" Q $$SCR^SDCO21(TYPE,DFN,SDDT,ENCPTR) ; SD*5.3*341
Q 1
;
STPCOD(DATA) ;
;INPUT DATA - stop code data to be checked
;
I '$D(DATA) Q 0
I DATA="" Q 0
I '$D(^DIC(40.7,"C",DATA)) Q 0
Q 1
;
ACTSTP(DATA,ENCDT) ;
;INPUT DATA - IEN of the stop code to be checked.
; ENCDT - the encounter date in question
;
N STPCOD,%DT,X,Y
I '$D(DATA) Q 0
I DATA="" Q 0
S STPCOD=$G(^DIC(40.7,DATA,0))
I STPCOD="" Q 0
I '$P(STPCOD,U,3) Q 1
S %DT(0)="-"_$P(STPCOD,U,3),%DT="T",X=ENCDT
D ^%DT
Q $S(Y=-1:0,1:1)
;
SERCON(DATA) ;
;INPUT DATA - Service connection to be checked, missing or invalid
;
I '$D(DATA) Q 0
I DATA="" Q 0
I DATA'=1,DATA'=0 Q 0
Q 1
;
SCPER(DATA) ;
;INPUT DATA - Service connected % to be tested
;
I '$D(DATA) Q 0
I DATA="" Q 1
I DATA'?.N.1".".N Q 0
Q 1
;
PRDSER(DATA) ;
;INPUT DATA - period of service to be tested.
;
I '$D(DATA) Q 0
I DATA="" Q 0
I '$D(^DIC(21,"D",DATA)) Q 0
Q 1
;
VIETSER1(DATA) ;
;INPUT DATA - Vietnam service to be checked
;
I '$D(DATA) Q 0
I DATA="" Q 1
I DATA'="Y",DATA'="N",DATA'="U" Q 0
Q 1
;
VIETSER2(DATA,DFN) ;
;INPUT DATA - Vietnam service to be checked against vet status
;
I '$D(DATA) Q 0
N VAR
S VAR=$G(^DPT(DFN,"VET"))
I DATA="",VAR'="Y" Q 1
I (DATA="Y"!(DATA="N")!(DATA="U")),VAR="Y" Q 1
Q 0
;
ACTPRD(DATA) ;
;INPUT DATA - period of serivce indicator to be check to ensure active
;
N VAR
I '$D(DATA) Q 0
I DATA="" Q 0
S VAR=+$O(^DIC(21,"D",DATA,0))
S VAR=$P($G(^DIC(21,VAR,0)),U,8)
I VAR Q 0
Q 1
;
PCODMTHD(DATA) ;
;INPUT DATA - The coding method to be checked.
;
I '$D(DATA) Q 0
I DATA'="C4" Q 0
Q 1
;
PROCCOD(DATA,ENCDT) ;
;INPUT DATA - The procedure code to be checked.
;This call makes the assumption that leading zeros are intact in the
;input.
;
N VAR
I '$D(DATA) Q 0
I DATA="" Q 0
I $$CPT^ICPTCOD(DATA,ENCDT,1)'>0 Q 0
Q 1
;
PROVCLS(DATA) ;
;INPUT DATA - The practitioner class to be checked.
;
N INACT S INACT=""
I '$D(DATA) Q 0
I DATA="" Q 0
I $$CODE2TXT^XUA4A72(DATA)']"" Q 0
S INACT=$P($$IEN2DATA^XUA4A72($$VCLK^XUA4A72(DATA)),U,5) ;SD*5.3*442
I INACT'="" I ENCDT>INACT Q 0 ;SD*5.3*442
Q 1
;
ERI(DATA) ;
;INPUT DATA - The Emergency Response indicator to be validated.
;
I '$D(DATA) Q 0
I DATA="" Q 1
I DATA'="K" Q 0
Q 1
;
SCMSVUT1 ;ALB/JLU;validation utility routine;06/19/99 ; 4/30/03 11:58am
+1 ;;5.3;Scheduling;**66,143,180,239,247,258,296,295,321,341,387,459,394,442,1015**;AUG 13,1993;Build 21
+2 ;06/19/99 ACS - Added CPT Modifier API calls to PROCCOD(DATA)
+3 ;
SEGERR(DATA,HLFS) ;
+1 ;INPUT DATA - This is a check for the segment errors of null
+2 ; HLFS - The string separator character
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF $LENGTH(DATA,HLFS)'>2
QUIT 0
+6 QUIT 1
+7 ;
DODA(DATA) ;
+1 ;INPUT DATA - The FM date of death.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 NEW %DT,X,Y
+6 SET %DT="T"
SET %DT(0)="-NOW"
SET X=DATA
+7 DO ^%DT
+8 QUIT $SELECT(Y=-1:0,1:1)
+9 ;
DODB(DATA,ENCDT) ;
+1 ;INPUT DATA - The FM date of death
+2 ; ENCDT - The FM date of encounter
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 NEW %DT,X,Y
+6 SET %DT="T"
SET %DT(0)=ENCDT
SET X=DATA
+7 DO ^%DT
+8 QUIT $SELECT(Y=-1:0,1:1)
+9 ;
DODL(DATA,ENCDT) ;
+1 ;INPUT DATA - The FM date of death
+2 ; ENCDT - The FM date of the encounter
+3 IF '$DATA(DATA)
QUIT 0
+4 IF '$DATA(ENCDT)
QUIT 0
+5 IF DATA=""
QUIT 1
+6 IF ENCDT<DATA
QUIT 1
+7 IF ENCDT=DATA
QUIT 1
+8 NEW X1,X2,X
+9 SET X1=ENCDT
SET X2=DATA
+10 DO ^%DTC
+11 IF X>14
QUIT 0
+12 QUIT 1
+13 ;
HOME(DATA) ;
+1 ;INPUT DATA - THe homeless indicator to be validated.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA'=1
IF DATA'=0
QUIT 0
+5 QUIT 1
+6 ;
POW(DATA) ;
+1 ;INPUT DATA - The POW indicatort to be validated.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 IF DATA'="N"
IF DATA'="U"
IF DATA'="Y"
QUIT 0
+6 QUIT 1
+7 ;
TYPINS(DATA) ;
+1 ;INPUT DATA - Type if insurance indicator to be validated.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 IF DATA?.A
QUIT 0
+6 IF DATA>-1
IF (DATA<13)
QUIT 1
+7 QUIT 0
+8 ;
PATCLSS(DATA) ;
+1 ;INPUT DATA - the patient's class
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF ("^O^I^")'[("^"_DATA_"^")
QUIT 0
+5 QUIT 1
+6 ;
POV(DATA) ;
+1 ;
+2 ;INPUT DATA - the purpose of visit.
+3 ;SD*5.3*394 - Correction for addition POV.
+4 ;
+5 NEW VAR
+6 IF '$DATA(DATA)
QUIT 0
+7 IF $LENGTH(DATA)'=4
QUIT 0
+8 IF DATA?.A
QUIT 0
+9 SET VAR=$EXTRACT(DATA,1,2)
+10 IF VAR<1!(VAR>4)
QUIT 0
+11 SET VAR=$EXTRACT(DATA,3,4)
+12 IF VAR<1!(VAR=10)
QUIT 0
+13 QUIT 1
+14 ;
COMPGEN(DATA) ;
+1 ;INPUT DATA - checking computer generated.
+2 ;
+3 NEW VAR
+4 SET VAR=$EXTRACT(DATA,3,4)
+5 IF VAR=10
QUIT 0
+6 QUIT 1
+7 ;
LOCVIS(DATA) ;
+1 ;INPUT DATA - Location of visit
+2 ;
+3 IF DATA'=1
IF DATA'=6
QUIT 0
+4 QUIT 1
+5 ;
FACNMBR(DATA) ;
+1 ;INPUT DATA - The facility number
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA'?3N.AN
QUIT 0
+5 IF '$DATA(^DIC(4,"D",DATA))
QUIT 0
+6 QUIT 1
+7 ;
FACACT(DATA,ENCDT,DIV) ;
+1 ;INPUT DATA - The active flag of the facility number.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF '$DATA(ENCDT)
QUIT 0
+5 IF '$DATA(DIV)
QUIT 0
+6 IF DATA=""
QUIT 0
+7 NEW SITE
+8 IF DIV]""
SET SITE=$$SITE^VASITE(ENCDT,DIV)
+9 IF DIV']""
SET SITE=$$SITE^VASITE(ENCDT)
+10 IF DATA'=$PIECE(SITE,U,3)
QUIT 0
+11 QUIT 1
+12 ;
ENCDT(DATA,XMTFLG) ;
+1 ;INPUT DATA - The date/time of the encounter
+2 ; XMTFLG - Flag to check $$OKTOXMIT^SCDXFU04(DATA)
+3 ;
+4 IF '$DATA(DATA)
QUIT 0
+5 SET XMTFLG=$GET(XMTFLG,0)
+6 NEW %DT,X,Y
+7 SET %DT="T"
+8 SET X=DATA
+9 DO ^%DT
+10 IF Y=-1
QUIT 0
+11 IF XMTFLG
QUIT 1
+12 NEW VAR
+13 SET VAR=$$OKTOXMIT^SCDXFU04(DATA)
+14 ;SD*5.3*247
IF +VAR<4&(VAR'<0)
QUIT 1
+15 QUIT 0
+16 ;
UNIQNMBR(DATA) ;
+1 ;INPUT DATA - The unique number from PCE for the encounter
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF DATA=-1
QUIT 0
+6 IF DATA=0
QUIT 0
+7 QUIT 1
+8 ;
SEGCHK(DATA,HLFS) ;
+1 ;INPUT DATA - The segment to be checked.
+2 ; HLFS - The HL7 field separator
+3 ;
+4 IF '$DATA(DATA)
QUIT 0
+5 IF DATA=""
QUIT 0
+6 IF $LENGTH(DATA,HLFS)'>2
QUIT 0
+7 QUIT 1
+8 ;
SEQNBR(DATA,SEQNBR) ;
+1 ;INPUT DATA - The sequence number to be checked.
+2 ; SEQNBR - This is the previous seq number to compare to
+3 ;
+4 IF '$DATA(DATA)
QUIT 0
+5 IF DATA=""
QUIT 0
+6 IF +DATA'=+SEQNBR
QUIT 0
+7 SET SEQNBR=SEQNBR+1
+8 QUIT 1
+9 ;
DCODMTHD(DATA) ;
+1 ;INPUT DATA - This is the coding method to be checked.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA'="I9"
QUIT 0
+5 QUIT 1
+6 ;
DIAGCOD(DATA,ENCDT) ;
+1 ;INPUT DATA - This is the diagnosis code
+2 ; ENCDT - This is the encounter date
+3 ;
+4 NEW VAR
+5 IF '$DATA(DATA)
QUIT 0
+6 IF DATA=""
QUIT 0
+7 ;
+8 QUIT $PIECE($$ICDDX^ICDCODE(DATA,ENCDT),"^",10)
+9 ;
PRIOR(DATA) ;
+1 ;INPUT DATA - The priority of the diagnosis found
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 IF DATA=1
QUIT 1
+6 QUIT 0
+7 ;
ELIGCODM(DATA) ;
+1 ;INPUT DATA - The eligibility code
+2 ;A CHECK FOR MISSING
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF '$DATA(^DIC(8.1,DATA,0))
QUIT 0
+6 QUIT 1
+7 ;
ELIGINCV(DATA) ;
+1 ;INPUT DATA - Contains the eligibility code in the first piece and
+2 ;the veteran status in the second.
+3 ;
+4 ;the following quit is to stop this edit check.
+5 ;Per Austin 9/97 this is not needed.
+6 QUIT 1
+7 NEW VET,ELIG
+8 SET VET=$PIECE(DATA,U,2)
+9 SET ELIG=$PIECE(DATA,U,1)
+10 IF VET=1&((ELIG<1)!(ELIG>18))
QUIT 0
+11 IF VET=1
IF ELIG>5
IF ELIG<15
QUIT 0
+12 IF VET=0
IF ELIG<6
QUIT 0
+13 IF VET=0
IF ELIG=11
QUIT 0
+14 IF VET=0
IF ELIG>14
IF ELIG'=19
QUIT 0
+15 QUIT 1
+16 ;
ELIGINCS(DATA) ;
+1 ;INPUT DATA - Eligibility code
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF '$DATA(^DIC(8.1,DATA,0))
QUIT 0
+6 IF +$PIECE(^DIC(8.1,DATA,0),U,7)
QUIT 0
+7 QUIT 1
+8 ;
VETSTAT(DATA) ;
+1 ;INPUT DATA - The veteran status indicator
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA'=0
IF DATA'=1
QUIT 0
+5 QUIT 1
+6 ;
VETPOW(DATA,DFN) ;
+1 ;INPUT DATA - veteran status to check with POW status.
+2 ; DFN - The DFN of the patient.
+3 ;
+4 NEW VAR,POW
+5 IF DATA=0
QUIT 1
+6 SET VAR=$GET(^DPT(DFN,.52))
+7 SET POW=$SELECT(VAR]"":$PIECE(VAR,U,5),1:VAR)
+8 IF POW=""
QUIT 1
+9 IF POW="Y"!(POW="N")!(POW="U")
QUIT 1
+10 QUIT 0
+11 ;
NMBRDEP(DATA) ;
+1 ;INPUT DATA - the number of dependents
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF DATA="XX"
QUIT 1
+6 IF DATA'?1.2N
QUIT 0
+7 IF +DATA>99!(+DATA<0)
QUIT 0
+8 QUIT 1
+9 ;
PATINC(DATA) ;
+1 ;INPUT DATA - The patient's income
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF DATA<0
QUIT 0
+6 IF DATA'?.N.1".".N
QUIT 0
+7 QUIT 1
+8 ;
MEANSTST(DATA) ;
+1 ;INPUT DATA - The means test indicator
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 SET DATA=","_DATA_","
+5 ; ** SD*296, added 'U' means test indicator to allowed list.
+6 IF ",AS,AN,N,X,C,G,U,"'[DATA
QUIT 0
+7 QUIT 1
+8 ;
DEPMEANS(DATA) ;
+1 ;INPUT DATA - This variable contains the number of dependents in the
+2 ; first peice and the means test indicator in the second.
+3 ;
+4 NEW MT,DEP
+5 IF '$DATA(DATA)
QUIT 0
+6 SET DEP=$PIECE(DATA,U,1)
+7 SET MT=","_$PIECE(DATA,U,2)_","
+8 IF DEP="XX"
IF (",AS,N,X,U,"'[MT)
QUIT 0
+9 QUIT 1
+10 ;
CLASSQUE(DATA) ;
+1 ;INPUT DATA - Classification question value.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA'=1
IF DATA'=0
IF DATA'=""
QUIT 0
+5 QUIT 1
+6 ;
CLAQUETY(DATA) ;
+1 ;INPUT DATA - Outpatient classification type to be checked.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF '$DATA(^SD(409.41,DATA,0))
QUIT 0
+6 QUIT 1
+7 ;
CLAVET(DATA,DFN,TYPE,ENCPTR) ; SD*5.3*341 added parameter ENCPTR
+1 ;INPUT DATA - Classification question information to compare to VET
+2 ; status
+3 ; DFN - The patient to compare this info to.
+4 ; TYPE - The classification type.
+5 ; ENCPTR - Pointer to Outpatient Encounter
+6 ;
+7 IF '$DATA(DATA)
QUIT 0
+8 IF '$DATA(DFN)
QUIT 0
+9 ; SD*5.3*341
IF '$DATA(TYPE)
QUIT 0
+10 ; SD*5.3*341
NEW VET,SDELG0,SDDT
+11 ; SD*5.3*341 added this plus next 3 lines
SET ENCPTR=$GET(ENCPTR)
+12 SET SDDT=+$GET(^SCE(ENCPTR,0))
IF 'SDDT
SET SDDT=$$DT^XLFDT()
+13 SET SDELG0=$$EL^SDCO22(DFN,ENCPTR)
+14 SET VET=$PIECE(SDELG0,U,5)
+15 IF VET="Y"
IF DATA'=1
IF DATA'=0
IF DATA'=""
QUIT 0
+16 ;This edit check is per a mail message from austin
+17 IF TYPE=4
IF VET'="Y"
IF DATA'=""
IF "^A^B^C^D^"'[("^"_($PIECE($GET(^DIC(21,+$PIECE($GET(^DPT(DFN,.32)),"^",3),0)),"^",3))_"^")
QUIT 0
+18 ; SD*5.3*341
IF VET'="Y"
IF DATA'=""
QUIT $$SCR^SDCO21(TYPE,DFN,SDDT,ENCPTR)
+19 QUIT 1
+20 ;
STPCOD(DATA) ;
+1 ;INPUT DATA - stop code data to be checked
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF '$DATA(^DIC(40.7,"C",DATA))
QUIT 0
+6 QUIT 1
+7 ;
ACTSTP(DATA,ENCDT) ;
+1 ;INPUT DATA - IEN of the stop code to be checked.
+2 ; ENCDT - the encounter date in question
+3 ;
+4 NEW STPCOD,%DT,X,Y
+5 IF '$DATA(DATA)
QUIT 0
+6 IF DATA=""
QUIT 0
+7 SET STPCOD=$GET(^DIC(40.7,DATA,0))
+8 IF STPCOD=""
QUIT 0
+9 IF '$PIECE(STPCOD,U,3)
QUIT 1
+10 SET %DT(0)="-"_$PIECE(STPCOD,U,3)
SET %DT="T"
SET X=ENCDT
+11 DO ^%DT
+12 QUIT $SELECT(Y=-1:0,1:1)
+13 ;
SERCON(DATA) ;
+1 ;INPUT DATA - Service connection to be checked, missing or invalid
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF DATA'=1
IF DATA'=0
QUIT 0
+6 QUIT 1
+7 ;
SCPER(DATA) ;
+1 ;INPUT DATA - Service connected % to be tested
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 IF DATA'?.N.1".".N
QUIT 0
+6 QUIT 1
+7 ;
PRDSER(DATA) ;
+1 ;INPUT DATA - period of service to be tested.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 0
+5 IF '$DATA(^DIC(21,"D",DATA))
QUIT 0
+6 QUIT 1
+7 ;
VIETSER1(DATA) ;
+1 ;INPUT DATA - Vietnam service to be checked
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 IF DATA'="Y"
IF DATA'="N"
IF DATA'="U"
QUIT 0
+6 QUIT 1
+7 ;
VIETSER2(DATA,DFN) ;
+1 ;INPUT DATA - Vietnam service to be checked against vet status
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 NEW VAR
+5 SET VAR=$GET(^DPT(DFN,"VET"))
+6 IF DATA=""
IF VAR'="Y"
QUIT 1
+7 IF (DATA="Y"!(DATA="N")!(DATA="U"))
IF VAR="Y"
QUIT 1
+8 QUIT 0
+9 ;
ACTPRD(DATA) ;
+1 ;INPUT DATA - period of serivce indicator to be check to ensure active
+2 ;
+3 NEW VAR
+4 IF '$DATA(DATA)
QUIT 0
+5 IF DATA=""
QUIT 0
+6 SET VAR=+$ORDER(^DIC(21,"D",DATA,0))
+7 SET VAR=$PIECE($GET(^DIC(21,VAR,0)),U,8)
+8 IF VAR
QUIT 0
+9 QUIT 1
+10 ;
PCODMTHD(DATA) ;
+1 ;INPUT DATA - The coding method to be checked.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA'="C4"
QUIT 0
+5 QUIT 1
+6 ;
PROCCOD(DATA,ENCDT) ;
+1 ;INPUT DATA - The procedure code to be checked.
+2 ;This call makes the assumption that leading zeros are intact in the
+3 ;input.
+4 ;
+5 NEW VAR
+6 IF '$DATA(DATA)
QUIT 0
+7 IF DATA=""
QUIT 0
+8 IF $$CPT^ICPTCOD(DATA,ENCDT,1)'>0
QUIT 0
+9 QUIT 1
+10 ;
PROVCLS(DATA) ;
+1 ;INPUT DATA - The practitioner class to be checked.
+2 ;
+3 NEW INACT
SET INACT=""
+4 IF '$DATA(DATA)
QUIT 0
+5 IF DATA=""
QUIT 0
+6 IF $$CODE2TXT^XUA4A72(DATA)']""
QUIT 0
+7 ;SD*5.3*442
SET INACT=$PIECE($$IEN2DATA^XUA4A72($$VCLK^XUA4A72(DATA)),U,5)
+8 ;SD*5.3*442
IF INACT'=""
IF ENCDT>INACT
QUIT 0
+9 QUIT 1
+10 ;
ERI(DATA) ;
+1 ;INPUT DATA - The Emergency Response indicator to be validated.
+2 ;
+3 IF '$DATA(DATA)
QUIT 0
+4 IF DATA=""
QUIT 1
+5 IF DATA'="K"
QUIT 0
+6 QUIT 1
+7 ;