SCMSVUT3 ;BP/JRP/DMR,TJB - HL7 segment & field validation utilities ; Jul 29, 2024
;;5.3;Scheduling;**142,180,208,239,395,441,543,777,864,886**;AUG 13, 1993;Build 13
;;Per VHA Directive 6402, this routine should not be modified
;
;Standard input parameters
; DATA - Value to validate
; DFN - Point to PATIENT file (#2)
; ENCDT - Date/time of encounter (FileMan format)
; HLFS - HL7 field seperator
; HLECH - HL7 encoding characters
; HLQ - HL7 null designation
;
;Standard output
; 1 - Valid
; 0 - Invalid
;
;
POWLOC(DATA,DFN) ;Prisoner of war location
;Note: Use of DFN is optional. Use of the DFN will validate the POW
; location and also verify that it is consistant with patient's
; POW status (i.e. must also have been a POW). Non-use of DFN
; will only validate the POW location.
;
Q:('$D(DATA)) 0
N POW,NODE
S DFN=+$G(DFN)
;Patient a POW ?
S POW=1
I (DFN) D
.S NODE=$G(^DPT(DFN,.52))
.S POW=$TR($P(NODE,"^",5),"YNU","100")
;Invalid location code
I (DATA'="")&("456789AB"'[DATA) Q 0
;Location code not consistant with POW status
I (DATA) Q:('POW) 0
I (DATA="") Q:((DFN)&(POW)) 0
;Valid location code
Q 1
RADMTHD(DATA,DFN) ;Radiation exposure method
;Note: Use of DFN is optional. Use of the DFN will validate the
; radiation method and also verify that it is consistant with
; patient's radiation exposure (i.e. must also have claimed
; exposure). Non-use of DFN will only validate the radiation
; method.
;
Q:('$D(DATA)) 0
N RAD,NODE
S DFN=+$G(DFN)
;Patient claim exposure ?
S RAD=1
I (DFN) D
.S NODE=$G(^DPT(DFN,.321))
.S RAD=$TR($P(NODE,"^",3),"YNU","100")
;Invalid method code
I (DATA'="") Q:((DATA'?1.2N)!(DATA<2)!(DATA>10)) 0
;Method code not consistant with exposure status
I (DATA) Q:('RAD) 0
I (DATA="") Q:((DFN)&(RAD)) 0
;Valid method code
Q 1
NUMRANK(DATA,MINVAL,MAXVAL,DECCNT) ;Numeric ranking validation
;Input : MINVAL - Minimum value (defaults to no lower limit)
; MAXVAL - Maximum value (defaults to no upper limit)
; DECCNT - Decimal places allowed (defaults to no limit)
;Note : DATA considered invalid if NULL
Q:('$D(DATA)) 0
Q:(DATA="") 0
Q:(DATA=".") 0
N INVALID
S INVALID=0
;General numeric check
Q:(DATA'?.1"-".N.1".".N) 0
;Min value check
I ($G(MINVAL)'="") D
.S INVALID=(DATA<MINVAL)
Q:(INVALID) 0
;Max value check
I ($G(MAXVAL)'="") D
.S INVALID=(DATA>MAXVAL)
Q:(INVALID) 0
;Decimal check
I ($G(DECCNT)'="") D
.X "S INVALID=DATA'?.1""-"".N.1"".""."_DECCNT_"N"
Q:(INVALID) 0
;Valid
Q 1
VALFAC(DATA) ;Determine if given facility number is valid
Q:('$D(DATA)) 0
Q:(DATA="") 0
;Invalid
Q:('$D(^DIC(4,"D",DATA))) 0
;Valid
Q 1
ACTFAC(DATA) ;Determine if given facility number is active
Q:('$D(DATA)) 0
Q:(DATA="") 0
N PTR4,ACTIVE,NODE
;Check all entries in INSTITUTION file (#4) with given facility number
; (quits when first active entry is found)
S ACTIVE=0
S PTR4=0
F S PTR4=+$O(^DIC(4,"D",DATA,PTR4)) Q:('PTR4) D Q:(ACTIVE)
.;Get node with inactive flag
.S NODE=$G(^DIC(4,PTR4,99))
.;Inactive
.Q:($P(NODE,"^",4)="y")
.;Active
.S ACTIVE=1
;Done
Q ACTIVE
PROVID(DATA,HLECH) ;External Provider ID
Q:('$D(DATA)) 0
Q:(DATA="") 0
N PRVDUZ,PRVFAC,SUBSEP,VALID
S SUBSEP=$E(HLECH,4)
S PRVDUZ=$P(DATA,SUBSEP,1)
S PRVFAC=$P(DATA,SUBSEP,2)
S VALID=0
I $$NUMRANK(PRVDUZ,1,,0),$$VALFAC(PRVFAC),$$ACTFAC(PRVFAC) S VALID=1
Q VALID
ROLEID(DATA) ;Role Instance ID
Q:('$D(DATA)) 0
Q:(DATA="") 0
N ROLEID,SEQID,VALID
S ROLEID=$P(DATA,"*",1)
S SEQID=$P(DATA,"*",2)
S VALID=0
I ROLEID'="" I $$NUMRANK(SEQID,1,,0) S VALID=1
Q VALID
VA01(DATA) ;VA Table 1 (Yes/No/Unknown)
;Notes: Table VA01 allows values of Y,N,U,1,0
; : NULL is an accepted value
Q:('$D(DATA)) 0
Q:(DATA="") 1
Q:($L(DATA)'=1) 0
N TMP
S TMP=$TR(DATA,"YNU0","1111")
Q:(TMP'=1) 0
Q 1
CLAMST(VALUE,DFN) ;
;Error code 9030
;Validating whether or not the visit is related to MST
;
;INPUT
; ENCDT - Date of encounter
; DFN - IEN pointer from the Outpatient Encounter (#409.68) file
; VALUE - Is encounter related (1=Yes,0=No)
;
;OUTPUT
; 1 = Visit is related to MST
; 0 = Visit Not related to MST
;
;
N MSTSTAT
I '$D(VALUE) Q 0
S MSTSTAT=$$GETSTAT^DGMSTAPI(DFN)
S MSTSTAT=$P(MSTSTAT,"^",2)
S MSTSTAT=$S(MSTSTAT="Y":1,1:0)
Q $S(MSTSTAT=0&(VALUE=1):0,1:1)
MSTSTAT(DATA) ;
;Error code 7040
;Check for valid MST status codes Y,N,D,U
;
;INPUT
; DATA - the MST Status passed in by routine SCMSVZEL
;
;OUTPUT
; 1 - Valid MST Status
; 0 - Invalid MST Status
;
I '$D(DATA) Q 0
I ("Y,N,U,D"[DATA)!(DATA="") Q 1
Q 0
MSTDATE(DATA) ;
;Error code 7060
;Check for valid date and that MST status is either Y,N,D or U
; Variable X must be passed to ^%DT for date verification
; Variable Y is returned from ^%DT
;
;INPUT
; DATA - MST Date Status Changed^MST Status from SCMSVZEL
;
;OUTPUT
; 1 - Valid MST Status and date in a valid format
; 0 - Invalid MST Status or date in an invalid format
;
N X,MSTSTAT
S X=$P(DATA,"^",2)
S MSTSTAT=$P(DATA,"^",1)
I X=""&("Y,N,D"'[MSTSTAT!(MSTSTAT="")) Q 1
S X=$$FMDATE^HLFNC(X),%DT="T"
D ^%DT
Q $S(Y>0&("U,Y,N,D"[MSTSTAT):1,1:0)
;
AO(DATA,DFN) ;Validate Agent Orange expos. (error 7120)
;INPUT : DATA - Value to validate
; DFN - Pointer to PATIENT file (#2)
;OUTPUT : 1 - Valid claim of exposure to Agent Orange
; 0 - Invalid claim of exposure to Agent Orange
I '$D(DATA) Q 0
I '$D(DFN) Q 0
I DATA=1 Q 1 ;$$CANBEAO(DFN) SD*5.3*395 rem check for period of service
I (DATA=0)!(DATA="") Q 1
Q 0
CANBEAO(DFN) ;Check to determine if patient can claim Agent Orange expos.
;INPUT : DFN - Pointer to PATIENT file (#2)
;OUTPUT : 1 - Valid claim of exposure to Agent Orange
; 0 - Invalid claim of exposure to Agent Orange
;
N VAEL
I '$G(DFN) Q 0
I '$D(^DPT(DFN,0)) Q 0
;Get data needed to perform check
D ELIG^VADPT
;Must be a veteran
I 'VAEL(4) Q 0
;Must have POS 7
I $P($G(^DIC(21,+VAEL(2),0)),"^",3)=7 Q 1
;Can't claim AO
Q 0
AOLOC(DATA,DFN) ;Validate Agent Orange exposure location (error 7130)
;INPUT : DATA - Value to validate
; DFN - Pointer to PATIENT file (#2)
;OUTPUT : 1 - Valid Agent Orange exposure location
; 0 - Invalid/missing Agent Orange exposure location
;NOTES : Patient's claiming exposure must have an exposure location
N VASV
I '$G(DFN) Q 0
I '$D(^DPT(DFN,0)) Q 0
I '$D(DATA) Q 0
;Get data needed to perform check
D SVC^VADPT
;No claim - shouldn't have a location
I 'VASV(2) Q $S(DATA="":1,1:0)
;Claims exposure - must have a valid location
;Q $S(DATA="":0,"VKOB"[DATA:1,1:0) ;SD*5.3*777 - Include BWN
Q $S(DATA="":0,"BKVTLCGJO"[DATA:1,1:0) ;SD*5.3*862
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSVUT3 6973 printed Sep 23, 2025@20:18:32 Page 2
SCMSVUT3 ;BP/JRP/DMR,TJB - HL7 segment & field validation utilities ; Jul 29, 2024
+1 ;;5.3;Scheduling;**142,180,208,239,395,441,543,777,864,886**;AUG 13, 1993;Build 13
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;Standard input parameters
+5 ; DATA - Value to validate
+6 ; DFN - Point to PATIENT file (#2)
+7 ; ENCDT - Date/time of encounter (FileMan format)
+8 ; HLFS - HL7 field seperator
+9 ; HLECH - HL7 encoding characters
+10 ; HLQ - HL7 null designation
+11 ;
+12 ;Standard output
+13 ; 1 - Valid
+14 ; 0 - Invalid
+15 ;
+16 ;
POWLOC(DATA,DFN) ;Prisoner of war location
+1 ;Note: Use of DFN is optional. Use of the DFN will validate the POW
+2 ; location and also verify that it is consistant with patient's
+3 ; POW status (i.e. must also have been a POW). Non-use of DFN
+4 ; will only validate the POW location.
+5 ;
+6 if ('$DATA(DATA))
QUIT 0
+7 NEW POW,NODE
+8 SET DFN=+$GET(DFN)
+9 ;Patient a POW ?
+10 SET POW=1
+11 IF (DFN)
Begin DoDot:1
+12 SET NODE=$GET(^DPT(DFN,.52))
+13 SET POW=$TRANSLATE($PIECE(NODE,"^",5),"YNU","100")
End DoDot:1
+14 ;Invalid location code
+15 IF (DATA'="")&("456789AB"'[DATA)
QUIT 0
+16 ;Location code not consistant with POW status
+17 IF (DATA)
if ('POW)
QUIT 0
+18 IF (DATA="")
if ((DFN)&(POW))
QUIT 0
+19 ;Valid location code
+20 QUIT 1
RADMTHD(DATA,DFN) ;Radiation exposure method
+1 ;Note: Use of DFN is optional. Use of the DFN will validate the
+2 ; radiation method and also verify that it is consistant with
+3 ; patient's radiation exposure (i.e. must also have claimed
+4 ; exposure). Non-use of DFN will only validate the radiation
+5 ; method.
+6 ;
+7 if ('$DATA(DATA))
QUIT 0
+8 NEW RAD,NODE
+9 SET DFN=+$GET(DFN)
+10 ;Patient claim exposure ?
+11 SET RAD=1
+12 IF (DFN)
Begin DoDot:1
+13 SET NODE=$GET(^DPT(DFN,.321))
+14 SET RAD=$TRANSLATE($PIECE(NODE,"^",3),"YNU","100")
End DoDot:1
+15 ;Invalid method code
+16 IF (DATA'="")
if ((DATA'?1.2N)!(DATA<2)!(DATA>10))
QUIT 0
+17 ;Method code not consistant with exposure status
+18 IF (DATA)
if ('RAD)
QUIT 0
+19 IF (DATA="")
if ((DFN)&(RAD))
QUIT 0
+20 ;Valid method code
+21 QUIT 1
NUMRANK(DATA,MINVAL,MAXVAL,DECCNT) ;Numeric ranking validation
+1 ;Input : MINVAL - Minimum value (defaults to no lower limit)
+2 ; MAXVAL - Maximum value (defaults to no upper limit)
+3 ; DECCNT - Decimal places allowed (defaults to no limit)
+4 ;Note : DATA considered invalid if NULL
+5 if ('$DATA(DATA))
QUIT 0
+6 if (DATA="")
QUIT 0
+7 if (DATA=".")
QUIT 0
+8 NEW INVALID
+9 SET INVALID=0
+10 ;General numeric check
+11 if (DATA'?.1"-".N.1".".N)
QUIT 0
+12 ;Min value check
+13 IF ($GET(MINVAL)'="")
Begin DoDot:1
+14 SET INVALID=(DATA<MINVAL)
End DoDot:1
+15 if (INVALID)
QUIT 0
+16 ;Max value check
+17 IF ($GET(MAXVAL)'="")
Begin DoDot:1
+18 SET INVALID=(DATA>MAXVAL)
End DoDot:1
+19 if (INVALID)
QUIT 0
+20 ;Decimal check
+21 IF ($GET(DECCNT)'="")
Begin DoDot:1
+22 XECUTE "S INVALID=DATA'?.1""-"".N.1"".""."_DECCNT_"N"
End DoDot:1
+23 if (INVALID)
QUIT 0
+24 ;Valid
+25 QUIT 1
VALFAC(DATA) ;Determine if given facility number is valid
+1 if ('$DATA(DATA))
QUIT 0
+2 if (DATA="")
QUIT 0
+3 ;Invalid
+4 if ('$DATA(^DIC(4,"D",DATA)))
QUIT 0
+5 ;Valid
+6 QUIT 1
ACTFAC(DATA) ;Determine if given facility number is active
+1 if ('$DATA(DATA))
QUIT 0
+2 if (DATA="")
QUIT 0
+3 NEW PTR4,ACTIVE,NODE
+4 ;Check all entries in INSTITUTION file (#4) with given facility number
+5 ; (quits when first active entry is found)
+6 SET ACTIVE=0
+7 SET PTR4=0
+8 FOR
SET PTR4=+$ORDER(^DIC(4,"D",DATA,PTR4))
if ('PTR4)
QUIT
Begin DoDot:1
+9 ;Get node with inactive flag
+10 SET NODE=$GET(^DIC(4,PTR4,99))
+11 ;Inactive
+12 if ($PIECE(NODE,"^",4)="y")
QUIT
+13 ;Active
+14 SET ACTIVE=1
End DoDot:1
if (ACTIVE)
QUIT
+15 ;Done
+16 QUIT ACTIVE
PROVID(DATA,HLECH) ;External Provider ID
+1 if ('$DATA(DATA))
QUIT 0
+2 if (DATA="")
QUIT 0
+3 NEW PRVDUZ,PRVFAC,SUBSEP,VALID
+4 SET SUBSEP=$EXTRACT(HLECH,4)
+5 SET PRVDUZ=$PIECE(DATA,SUBSEP,1)
+6 SET PRVFAC=$PIECE(DATA,SUBSEP,2)
+7 SET VALID=0
+8 IF $$NUMRANK(PRVDUZ,1,,0)
IF $$VALFAC(PRVFAC)
IF $$ACTFAC(PRVFAC)
SET VALID=1
+9 QUIT VALID
ROLEID(DATA) ;Role Instance ID
+1 if ('$DATA(DATA))
QUIT 0
+2 if (DATA="")
QUIT 0
+3 NEW ROLEID,SEQID,VALID
+4 SET ROLEID=$PIECE(DATA,"*",1)
+5 SET SEQID=$PIECE(DATA,"*",2)
+6 SET VALID=0
+7 IF ROLEID'=""
IF $$NUMRANK(SEQID,1,,0)
SET VALID=1
+8 QUIT VALID
VA01(DATA) ;VA Table 1 (Yes/No/Unknown)
+1 ;Notes: Table VA01 allows values of Y,N,U,1,0
+2 ; : NULL is an accepted value
+3 if ('$DATA(DATA))
QUIT 0
+4 if (DATA="")
QUIT 1
+5 if ($LENGTH(DATA)'=1)
QUIT 0
+6 NEW TMP
+7 SET TMP=$TRANSLATE(DATA,"YNU0","1111")
+8 if (TMP'=1)
QUIT 0
+9 QUIT 1
CLAMST(VALUE,DFN) ;
+1 ;Error code 9030
+2 ;Validating whether or not the visit is related to MST
+3 ;
+4 ;INPUT
+5 ; ENCDT - Date of encounter
+6 ; DFN - IEN pointer from the Outpatient Encounter (#409.68) file
+7 ; VALUE - Is encounter related (1=Yes,0=No)
+8 ;
+9 ;OUTPUT
+10 ; 1 = Visit is related to MST
+11 ; 0 = Visit Not related to MST
+12 ;
+13 ;
+14 NEW MSTSTAT
+15 IF '$DATA(VALUE)
QUIT 0
+16 SET MSTSTAT=$$GETSTAT^DGMSTAPI(DFN)
+17 SET MSTSTAT=$PIECE(MSTSTAT,"^",2)
+18 SET MSTSTAT=$SELECT(MSTSTAT="Y":1,1:0)
+19 QUIT $SELECT(MSTSTAT=0&(VALUE=1):0,1:1)
MSTSTAT(DATA) ;
+1 ;Error code 7040
+2 ;Check for valid MST status codes Y,N,D,U
+3 ;
+4 ;INPUT
+5 ; DATA - the MST Status passed in by routine SCMSVZEL
+6 ;
+7 ;OUTPUT
+8 ; 1 - Valid MST Status
+9 ; 0 - Invalid MST Status
+10 ;
+11 IF '$DATA(DATA)
QUIT 0
+12 IF ("Y,N,U,D"[DATA)!(DATA="")
QUIT 1
+13 QUIT 0
MSTDATE(DATA) ;
+1 ;Error code 7060
+2 ;Check for valid date and that MST status is either Y,N,D or U
+3 ; Variable X must be passed to ^%DT for date verification
+4 ; Variable Y is returned from ^%DT
+5 ;
+6 ;INPUT
+7 ; DATA - MST Date Status Changed^MST Status from SCMSVZEL
+8 ;
+9 ;OUTPUT
+10 ; 1 - Valid MST Status and date in a valid format
+11 ; 0 - Invalid MST Status or date in an invalid format
+12 ;
+13 NEW X,MSTSTAT
+14 SET X=$PIECE(DATA,"^",2)
+15 SET MSTSTAT=$PIECE(DATA,"^",1)
+16 IF X=""&("Y,N,D"'[MSTSTAT!(MSTSTAT=""))
QUIT 1
+17 SET X=$$FMDATE^HLFNC(X)
SET %DT="T"
+18 DO ^%DT
+19 QUIT $SELECT(Y>0&("U,Y,N,D"[MSTSTAT):1,1:0)
+20 ;
AO(DATA,DFN) ;Validate Agent Orange expos. (error 7120)
+1 ;INPUT : DATA - Value to validate
+2 ; DFN - Pointer to PATIENT file (#2)
+3 ;OUTPUT : 1 - Valid claim of exposure to Agent Orange
+4 ; 0 - Invalid claim of exposure to Agent Orange
+5 IF '$DATA(DATA)
QUIT 0
+6 IF '$DATA(DFN)
QUIT 0
+7 ;$$CANBEAO(DFN) SD*5.3*395 rem check for period of service
IF DATA=1
QUIT 1
+8 IF (DATA=0)!(DATA="")
QUIT 1
+9 QUIT 0
CANBEAO(DFN) ;Check to determine if patient can claim Agent Orange expos.
+1 ;INPUT : DFN - Pointer to PATIENT file (#2)
+2 ;OUTPUT : 1 - Valid claim of exposure to Agent Orange
+3 ; 0 - Invalid claim of exposure to Agent Orange
+4 ;
+5 NEW VAEL
+6 IF '$GET(DFN)
QUIT 0
+7 IF '$DATA(^DPT(DFN,0))
QUIT 0
+8 ;Get data needed to perform check
+9 DO ELIG^VADPT
+10 ;Must be a veteran
+11 IF 'VAEL(4)
QUIT 0
+12 ;Must have POS 7
+13 IF $PIECE($GET(^DIC(21,+VAEL(2),0)),"^",3)=7
QUIT 1
+14 ;Can't claim AO
+15 QUIT 0
AOLOC(DATA,DFN) ;Validate Agent Orange exposure location (error 7130)
+1 ;INPUT : DATA - Value to validate
+2 ; DFN - Pointer to PATIENT file (#2)
+3 ;OUTPUT : 1 - Valid Agent Orange exposure location
+4 ; 0 - Invalid/missing Agent Orange exposure location
+5 ;NOTES : Patient's claiming exposure must have an exposure location
+6 NEW VASV
+7 IF '$GET(DFN)
QUIT 0
+8 IF '$DATA(^DPT(DFN,0))
QUIT 0
+9 IF '$DATA(DATA)
QUIT 0
+10 ;Get data needed to perform check
+11 DO SVC^VADPT
+12 ;No claim - shouldn't have a location
+13 IF 'VASV(2)
QUIT $SELECT(DATA="":1,1:0)
+14 ;Claims exposure - must have a valid location
+15 ;Q $S(DATA="":0,"VKOB"[DATA:1,1:0) ;SD*5.3*777 - Include BWN
+16 ;SD*5.3*862
QUIT $SELECT(DATA="":0,"BKVTLCGJO"[DATA:1,1:0)
