Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMSVUT3

SCMSVUT3.m

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