- SCMSVUT0 ;ALB/ESD HL7 Segment Validation Utilities ; 7/8/04 5:06pm
- ;;5.3;Scheduling;**44,55,66,132,245,254,293,345,472,441,551,552**;Aug 13, 1993;Build 5
- ;
- ;
- CONVERT(SEG,HLFS,HLQ) ; Convert HLQ ("") to null in segment
- ; Input: SEG = HL7 segment
- ; HLFS = HL7 field separator
- ; HLQ = HL7 "" character
- ;
- ; Output: SEG = Segment where HLQ replaced with null
- ;
- ;
- N I
- F I=1:1:55 I $P(SEG,HLFS,I)=HLQ S $P(SEG,HLFS,I)=""
- Q SEG
- ;
- SETID(SDOE,SDDELOE) ; Set PCE Unique Visit Number in field #.2 of #409.68
- ; Input: SDOE = IEN of Outpatient Encounter (#409.68) file
- ; SDDELOE = IEN of Deleted Outpatient Encounter (#409.74) file
- ;
- ; Output: Unique Visit Number set in field #.2 of #409.68
- ; or field #.2 of #409.74
- ;
- ;
- N SDOEC,SDARRY
- S SDOEC=0
- S SDOE=+$G(SDOE)
- S SDDELOE=+$G(SDDELOE)
- ;
- ;-Outpatient Enc pointer passed in; use file #409.68
- S SDARRY="^SCE("_SDOE_",0)"
- ;
- ;-Deleted Outpatient Enc pointer passed in; use file #409.74
- S:(SDDELOE) SDARRY="^SD(409.74,"_SDDELOE_",1)"
- ;
- ;-Quit if no encounter record or deleted encounter record
- Q:($G(@SDARRY)="")
- ;-Add unique ID to parent
- D GETID
- ;
- ;-Add unique ID to children for Outpatient Enc only (quit if no child encounter record)
- I (SDOE) F S SDOEC=+$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC S SDARRY="^SCE("_SDOEC_",0)" Q:($G(@SDARRY)="") D GETID
- Q
- ;
- GETID ;Get unique visit ID
- S:$P($G(@SDARRY),"^",20)="" $P(@SDARRY,"^",20)=$$IEN2VID^VSIT($P(@SDARRY,"^",5))
- Q
- ;
- SETPRTY(SDOE) ;Set outpatient provider type in field #.06 of V PROVIDER
- ; Input: SDOE = IEN of Outpatient Encounter (#409.68) file
- ;
- ; Output: Provider Type set in field #.06 of V PROVIDER
- ;
- ;
- N SDPRTYP,SDVPRV,SDPRVS
- S SDOE=+$G(SDOE),SDVPRV=0
- ;
- ;- Get all provider IENs for encounter
- D GETPRV^SDOE(SDOE,"SDPRVS")
- F S SDVPRV=+$O(SDPRVS(SDVPRV)) Q:'SDVPRV D
- . S SDPRTYP=0
- . ;
- . ;- If no prov type, call API and add provider type to record
- . S:$P(SDPRVS(SDVPRV),"^",6)="" SDPRTYP=$$GET^XUA4A72(+SDPRVS(SDVPRV),+$G(^SCE(SDOE,0)))
- . I +$G(SDPRTYP)>0 D PCLASS^PXAPIOE(SDVPRV)
- Q
- ;
- SETMAR(PIDSEG,HLQ,HLFS,HLECH) ; Set marital status prior to PID segment validation
- ;Input: PIDSEG = Array containing PID segment (pass by reference)
- ; PIDSEG = First 245 characters
- ; PIDSEG(1..n) = Continuation nodes
- ; HLQ = HL7 null variable
- ; HLFS = HL7 field separator
- ; HLECH = HL7 encoding characters (VAFCQRY1 call)
- ;Output: Marital status changed from null to "U" (UNKNOWN) prior to
- ; validation of PID segment and transmittal to AAC
- ;Note: Assumes all input exists and is valid
- ;
- ;Declare variables
- N REBLD,TMPARR,X,TMPARR3,TMPARR5,TMPARR11
- ;Parse segment
- D SEGPRSE^SCMSVUT5($NA(PIDSEG),"TMPARR",HLFS)
- ;Change marital status (if needed)
- S REBLD=0
- S X=$G(TMPARR(16))
- I ((X="")!(X=HLQ)) S TMPARR(16)="U",REBLD=1
- I $D(HLECH) D Q ;from SCDXMSG1 (VAFCQRY call)
- . ;Change religion (if needed)
- . S X=$G(TMPARR(17))
- . I ((X="")!(X=HLQ)) S TMPARR(17)=29
- . ;Rebuild segment (due to VAFCQRY call building seg. array)
- . ;VAFCQRY Seqs 3,5,11 needs to be broken down - too long for rebuild
- . K TMPARR(0),PIDSEG
- . D SEQPRSE^SCMSVUT5($NA(TMPARR(3)),"TMPARR3",HLECH)
- . D SEQPRSE^SCMSVUT5($NA(TMPARR(5)),"TMPARR5",HLECH)
- . D SEQPRSE^SCMSVUT5($NA(TMPARR(11)),"TMPARR11",HLECH)
- . K TMPARR(3) M TMPARR(3)=TMPARR3
- . K TMPARR(5) M TMPARR(5)=TMPARR5
- . K TMPARR(11) M TMPARR(11)=TMPARR11
- . D MAKEIT^VAFHLU("PID",.TMPARR,.PIDSEG,.PIDSEG)
- I REBLD K TMPARR(0),PIDSEG D MAKEIT^VAFHLU("PID",.TMPARR,.PIDSEG,.PIDSEG)
- Q
- ;
- SETPOW(DFN,ZPDSEG,HLQ,HLFS) ; Set POW Status Indicated field prior to ZPD segment validation
- ;
- ; Input: DFN = IEN of Patient (#2) file
- ; ZPDSEG = Array containing ZPD segment (pass by reference)
- ; ZPDSEG = First 245 characters
- ; ZPDSEG(1..n) = Continuation nodes
- ; HLQ = HL7 null variable
- ; HLFS = HL7 field separator
- ;
- ; Output: If Veteran and POW Status Indicated field = null, set to
- ; U (Unknown)
- ; If Non-Veteran, set to null
- ;
- S DFN=$G(DFN)
- G SETPOWQ:(DFN="")!($G(ZPDSEG)="")
- ;Declare variables
- N REBLD,TMPARR,X
- ;Parse segment
- D SEGPRSE^SCMSVUT5($NA(ZPDSEG),"TMPARR",HLFS)
- ;Change POW status (if needed)
- S REBLD=0
- S X=$G(TMPARR(17))
- I $P($G(^DPT(DFN,"VET")),"^")="Y",(X=""!(X=HLQ)) S TMPARR(17)="U",REBLD=1
- I $P($G(^DPT(DFN,"VET")),"^")="N" S TMPARR(17)=HLQ,REBLD=1
- ;Rebuild segment (if needed)
- I REBLD K TMPARR(0),ZPDSEG D MAKEIT^VAFHLU("ZPD",.TMPARR,.ZPDSEG,.ZPDSEG)
- ;
- SETPOWQ Q
- ;
- ;
- SETVSI(DFN,ZSPSEG,HLQ,HLFS) ;Set Vietnam Service Indicated field prior to ZSP segment validation
- ;
- ; Input: DFN = IEN of Patient (#2) file
- ; ZSPSEG = HL7 ZSP segment
- ; HLQ = HL7 null variable
- ; HLFS = HL7 field separator
- ;
- ; Output: If Veteran and Vietnam Service Indicated field = null,
- ; set to U (Unknown)
- ; If Non-Veteran, set to null
- ;
- S DFN=$G(DFN),ZSPSEG=$G(ZSPSEG)
- G SETVSIQ:(DFN="")!(ZSPSEG="")
- I $P($G(^DPT(DFN,"VET")),"^")="Y",($P(ZSPSEG,HLFS,6)=""!($P(ZSPSEG,HLFS,6)=HLQ)) S $P(ZSPSEG,HLFS,6)="U"
- I $P($G(^DPT(DFN,"VET")),"^")="N" S $P(ZSPSEG,HLFS,6)=HLQ
- ;
- SETVSIQ Q ZSPSEG
- ;
- ;
- ;
- ;The following subroutines all have to do with the validation of
- ;data using the same edit checks that are used by Austin.
- ;
- HL7SEGNM(SEG,DATA) ;checks the validity of the HL7 segment name passed in.
- ;INPUT SEG - the HL7 segment name
- ; DATA - the data to compare. In this case the HL7 segment name.
- ;
- ;OUTPUT 0 (ZERO) if not validate
- ; 1 if validated
- ;
- I '$D(SEG)!('$D(DATA)) Q 0
- Q $S(SEG=DATA:1,1:0)
- ;
- EVTTYP(SEG,DATA) ;checks the event type of the segment passed in.
- ;INPUT SEG - The HL7 segment name in question
- ; DATA - The event type from the HL7 segment in question.
- ;
- ;OUTPUT 0 (ZERO) if not validate
- ; 1 if validated
- ;
- I '$D(SEG)!('$D(DATA)) Q 0
- I SEG="EVN"&(DATA="A08"!(DATA="A23")) Q 1
- Q 0
- ;
- EVTDTTM(DATA) ;Checks the date and time to ensure it is correct.
- ;INPUT DATA - this is the date and time in quesiton.
- ;
- ;OUTPUT 0 (ZERO) if not validate
- ; 1 if validated
- ;
- I '$D(DATA) Q 0
- N STRTDT,%DT,X,Y
- S STRTDT=+$O(^SD(404.91,0))
- S STRTDT=$P($G(^SD(404.91,STRTDT,"AMB")),U,2)
- I 'STRTDT Q 0
- S %DT="T",%DT(0)=STRTDT,X=DATA
- D ^%DT
- Q $S(Y=-1:0,1:1)
- ;
- VALIDATE(SEG,DATA,ERRCOD,VALERR,CTR) ;
- ;
- N ERRIEN,ERRCHK,RES
- S ERRIEN=+$O(^SD(409.76,"B",ERRCOD,""))
- I 'ERRIEN S @VALERR@(SEG,CTR)=ERRCOD D INCR Q
- S ERRCHK=$G(^SD(409.76,ERRIEN,"CHK"))
- I ERRCHK="" S @VALERR@(SEG,CTR)=ERRCOD D INCR Q
- X ERRCHK
- I 'RES S @VALERR@(SEG,CTR)=ERRCOD D INCR
- Q
- ;
- DFN(DATA) ;
- ;INPUT DATA - the DFN of the patient
- ;
- I '$D(DATA) Q 0
- I DATA=""!(DATA=0) Q 0
- I DATA'?1.N.".".N Q 0
- Q 1
- ;
- PATNM(DATA) ;
- ;INPUT DATA - The name of the patient
- ;
- I '$D(DATA) Q 0
- I DATA="" Q 0
- I DATA?.N.",".N Q 0
- I DATA?1.C Q 0
- Q 1
- ;
- DOB(DATA,ENCDT) ;
- ;INPUT DATA - The DOB to be tested.
- ; ENCDT - The date/time of the encounter
- ;
- N %DT,X,Y
- I '$D(DATA) Q 0
- I '$D(ENCDT) Q 0
- I DATA'?1.N Q 0
- S %DT="T",%DT(0)=-ENCDT,X=DATA
- D ^%DT
- Q $S(Y=-1:0,1:1)
- ;
- SEX(DATA) ;
- ;INPUT DATA - The sex code to be validated
- ;
- I '$D(DATA) Q 0
- I "FMUO"'[DATA Q 0
- Q 1
- ;
- RACE(DATA) ;
- ;INPUT DATA - the race 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
- ;
- STR1(DATA) ;
- ;INPUT DATA - Street address line 1
- ;
- N LP,VAR
- I '$D(DATA) Q 0
- I DATA="" Q 0
- I DATA?1.N Q 0
- I DATA=" " Q 0
- F LP=1:1:$L(DATA) S VAR=$E(DATA,LP,LP) I $A(VAR)>32,($A(VAR)<127) S LP="Y" Q
- Q $S(LP="Y":1,1:0)
- ;
- STR2(DATA) ;
- ;INPUT DATA - Street address line 2
- I DATA?1.N Q 0
- Q 1
- ;
- CITY(DATA) ;
- ;INPUT DATA - The city code to be validated
- ;
- I DATA="" Q 0
- I DATA?1.N Q 0
- Q 1
- ;
- STATE(DATA) ;
- ;INPUT DATA - State code to be validated.
- ;
- I '$D(DATA) Q 0
- I DATA="" Q 0
- I '$D(^DIC(5,"C",DATA)) Q 0
- Q 1
- ;
- ZIP(DATA) ;
- ;INPUT DATA - The zipo code to be validated
- ;
- I '$D(DATA) Q 0
- I $E(DATA,1,5)="00000" Q 0
- I DATA'?5N."-".4N Q 0
- Q 1
- ;
- COUNTY(DATA,STATE) ;
- ;INPUT DATA - The county code to be validated
- ; STATE - STATE file IEN
- ;
- I DATA="" Q 0
- I STATE="" Q 0
- I '$D(^DIC(5,+$G(STATE),1,"C",DATA)) Q 0
- Q 1
- ;
- MARITAL(DATA) ;
- ;INPUT DATA - The marital status code to be validated.
- ;
- I $L(DATA)>1 Q 0
- I "ADMSWU"'[DATA Q 0
- Q 1
- ;
- REL(DATA) ;
- ;INPUT DATA - The religion abbreviation to the validated
- ;
- I '$D(DATA) Q 0
- I DATA="" Q 0
- I '$D(^DIC(13,"C",+DATA)) Q 0
- Q 1
- ;
- SSN(DATA,NOPCHK,NULLOK) ; SD*5.3*345 added optional parameter NULLOK
- ;INPUT DATA - The SSN to be validated
- ; NOPCHK - O = Check pseudo indicator (default)
- ; 1 = Don't check pseudo indicator
- ; NULLOK (optional) - 1 = Allow SSN to be null
- ; 2 = Don't allow null SSNs (default)
- ;
- I $G(DATA)="" Q +$G(NULLOK) ; SD*5.3*345
- I '$D(DATA) Q 0
- N SSN,PSD
- S SSN=$E(DATA,1,9),PSD=$E(DATA,10)
- I SSN'?9N Q 0
- I '$G(NOPCHK) I (PSD'=" "),(PSD'=""),(PSD'="P") Q 0
- I $E(SSN,1,5)="00000" Q 0
- Q 1
- ;
- INCR ;increases the counter
- S CTR=CTR+1
- Q
- ;
- REMOVE(SEG,ERR,VALERR,CNT) ;
- ;INPUT SEG - The segment being worked on
- ; VALERR - The array holding the information
- ; CNT - the counter to use
- ; ERR - error code to remove
- ;
- N LP
- F LP=1:1:CNT I $G(@VALERR@(SEG,LP))=ERR K @VALERR@(SEG,LP)
- Q
- ;
- DECR(CNT) ;
- S CNT=CNT-1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSVUT0 10009 printed Feb 19, 2025@00:08:35 Page 2
- SCMSVUT0 ;ALB/ESD HL7 Segment Validation Utilities ; 7/8/04 5:06pm
- +1 ;;5.3;Scheduling;**44,55,66,132,245,254,293,345,472,441,551,552**;Aug 13, 1993;Build 5
- +2 ;
- +3 ;
- CONVERT(SEG,HLFS,HLQ) ; Convert HLQ ("") to null in segment
- +1 ; Input: SEG = HL7 segment
- +2 ; HLFS = HL7 field separator
- +3 ; HLQ = HL7 "" character
- +4 ;
- +5 ; Output: SEG = Segment where HLQ replaced with null
- +6 ;
- +7 ;
- +8 NEW I
- +9 FOR I=1:1:55
- IF $PIECE(SEG,HLFS,I)=HLQ
- SET $PIECE(SEG,HLFS,I)=""
- +10 QUIT SEG
- +11 ;
- SETID(SDOE,SDDELOE) ; Set PCE Unique Visit Number in field #.2 of #409.68
- +1 ; Input: SDOE = IEN of Outpatient Encounter (#409.68) file
- +2 ; SDDELOE = IEN of Deleted Outpatient Encounter (#409.74) file
- +3 ;
- +4 ; Output: Unique Visit Number set in field #.2 of #409.68
- +5 ; or field #.2 of #409.74
- +6 ;
- +7 ;
- +8 NEW SDOEC,SDARRY
- +9 SET SDOEC=0
- +10 SET SDOE=+$GET(SDOE)
- +11 SET SDDELOE=+$GET(SDDELOE)
- +12 ;
- +13 ;-Outpatient Enc pointer passed in; use file #409.68
- +14 SET SDARRY="^SCE("_SDOE_",0)"
- +15 ;
- +16 ;-Deleted Outpatient Enc pointer passed in; use file #409.74
- +17 if (SDDELOE)
- SET SDARRY="^SD(409.74,"_SDDELOE_",1)"
- +18 ;
- +19 ;-Quit if no encounter record or deleted encounter record
- +20 if ($GET(@SDARRY)="")
- QUIT
- +21 ;-Add unique ID to parent
- +22 DO GETID
- +23 ;
- +24 ;-Add unique ID to children for Outpatient Enc only (quit if no child encounter record)
- +25 IF (SDOE)
- FOR
- SET SDOEC=+$ORDER(^SCE("APAR",SDOE,SDOEC))
- if 'SDOEC
- QUIT
- SET SDARRY="^SCE("_SDOEC_",0)"
- if ($GET(@SDARRY)="")
- QUIT
- DO GETID
- +26 QUIT
- +27 ;
- GETID ;Get unique visit ID
- +1 if $PIECE($GET(@SDARRY),"^",20)=""
- SET $PIECE(@SDARRY,"^",20)=$$IEN2VID^VSIT($PIECE(@SDARRY,"^",5))
- +2 QUIT
- +3 ;
- SETPRTY(SDOE) ;Set outpatient provider type in field #.06 of V PROVIDER
- +1 ; Input: SDOE = IEN of Outpatient Encounter (#409.68) file
- +2 ;
- +3 ; Output: Provider Type set in field #.06 of V PROVIDER
- +4 ;
- +5 ;
- +6 NEW SDPRTYP,SDVPRV,SDPRVS
- +7 SET SDOE=+$GET(SDOE)
- SET SDVPRV=0
- +8 ;
- +9 ;- Get all provider IENs for encounter
- +10 DO GETPRV^SDOE(SDOE,"SDPRVS")
- +11 FOR
- SET SDVPRV=+$ORDER(SDPRVS(SDVPRV))
- if 'SDVPRV
- QUIT
- Begin DoDot:1
- +12 SET SDPRTYP=0
- +13 ;
- +14 ;- If no prov type, call API and add provider type to record
- +15 if $PIECE(SDPRVS(SDVPRV),"^",6)=""
- SET SDPRTYP=$$GET^XUA4A72(+SDPRVS(SDVPRV),+$GET(^SCE(SDOE,0)))
- +16 IF +$GET(SDPRTYP)>0
- DO PCLASS^PXAPIOE(SDVPRV)
- End DoDot:1
- +17 QUIT
- +18 ;
- SETMAR(PIDSEG,HLQ,HLFS,HLECH) ; Set marital status prior to PID segment validation
- +1 ;Input: PIDSEG = Array containing PID segment (pass by reference)
- +2 ; PIDSEG = First 245 characters
- +3 ; PIDSEG(1..n) = Continuation nodes
- +4 ; HLQ = HL7 null variable
- +5 ; HLFS = HL7 field separator
- +6 ; HLECH = HL7 encoding characters (VAFCQRY1 call)
- +7 ;Output: Marital status changed from null to "U" (UNKNOWN) prior to
- +8 ; validation of PID segment and transmittal to AAC
- +9 ;Note: Assumes all input exists and is valid
- +10 ;
- +11 ;Declare variables
- +12 NEW REBLD,TMPARR,X,TMPARR3,TMPARR5,TMPARR11
- +13 ;Parse segment
- +14 DO SEGPRSE^SCMSVUT5($NAME(PIDSEG),"TMPARR",HLFS)
- +15 ;Change marital status (if needed)
- +16 SET REBLD=0
- +17 SET X=$GET(TMPARR(16))
- +18 IF ((X="")!(X=HLQ))
- SET TMPARR(16)="U"
- SET REBLD=1
- +19 ;from SCDXMSG1 (VAFCQRY call)
- IF $DATA(HLECH)
- Begin DoDot:1
- +20 ;Change religion (if needed)
- +21 SET X=$GET(TMPARR(17))
- +22 IF ((X="")!(X=HLQ))
- SET TMPARR(17)=29
- +23 ;Rebuild segment (due to VAFCQRY call building seg. array)
- +24 ;VAFCQRY Seqs 3,5,11 needs to be broken down - too long for rebuild
- +25 KILL TMPARR(0),PIDSEG
- +26 DO SEQPRSE^SCMSVUT5($NAME(TMPARR(3)),"TMPARR3",HLECH)
- +27 DO SEQPRSE^SCMSVUT5($NAME(TMPARR(5)),"TMPARR5",HLECH)
- +28 DO SEQPRSE^SCMSVUT5($NAME(TMPARR(11)),"TMPARR11",HLECH)
- +29 KILL TMPARR(3)
- MERGE TMPARR(3)=TMPARR3
- +30 KILL TMPARR(5)
- MERGE TMPARR(5)=TMPARR5
- +31 KILL TMPARR(11)
- MERGE TMPARR(11)=TMPARR11
- +32 DO MAKEIT^VAFHLU("PID",.TMPARR,.PIDSEG,.PIDSEG)
- End DoDot:1
- QUIT
- +33 IF REBLD
- KILL TMPARR(0),PIDSEG
- DO MAKEIT^VAFHLU("PID",.TMPARR,.PIDSEG,.PIDSEG)
- +34 QUIT
- +35 ;
- SETPOW(DFN,ZPDSEG,HLQ,HLFS) ; Set POW Status Indicated field prior to ZPD segment validation
- +1 ;
- +2 ; Input: DFN = IEN of Patient (#2) file
- +3 ; ZPDSEG = Array containing ZPD segment (pass by reference)
- +4 ; ZPDSEG = First 245 characters
- +5 ; ZPDSEG(1..n) = Continuation nodes
- +6 ; HLQ = HL7 null variable
- +7 ; HLFS = HL7 field separator
- +8 ;
- +9 ; Output: If Veteran and POW Status Indicated field = null, set to
- +10 ; U (Unknown)
- +11 ; If Non-Veteran, set to null
- +12 ;
- +13 SET DFN=$GET(DFN)
- +14 if (DFN="")!($GET(ZPDSEG)="")
- GOTO SETPOWQ
- +15 ;Declare variables
- +16 NEW REBLD,TMPARR,X
- +17 ;Parse segment
- +18 DO SEGPRSE^SCMSVUT5($NAME(ZPDSEG),"TMPARR",HLFS)
- +19 ;Change POW status (if needed)
- +20 SET REBLD=0
- +21 SET X=$GET(TMPARR(17))
- +22 IF $PIECE($GET(^DPT(DFN,"VET")),"^")="Y"
- IF (X=""!(X=HLQ))
- SET TMPARR(17)="U"
- SET REBLD=1
- +23 IF $PIECE($GET(^DPT(DFN,"VET")),"^")="N"
- SET TMPARR(17)=HLQ
- SET REBLD=1
- +24 ;Rebuild segment (if needed)
- +25 IF REBLD
- KILL TMPARR(0),ZPDSEG
- DO MAKEIT^VAFHLU("ZPD",.TMPARR,.ZPDSEG,.ZPDSEG)
- +26 ;
- SETPOWQ QUIT
- +1 ;
- +2 ;
- SETVSI(DFN,ZSPSEG,HLQ,HLFS) ;Set Vietnam Service Indicated field prior to ZSP segment validation
- +1 ;
- +2 ; Input: DFN = IEN of Patient (#2) file
- +3 ; ZSPSEG = HL7 ZSP segment
- +4 ; HLQ = HL7 null variable
- +5 ; HLFS = HL7 field separator
- +6 ;
- +7 ; Output: If Veteran and Vietnam Service Indicated field = null,
- +8 ; set to U (Unknown)
- +9 ; If Non-Veteran, set to null
- +10 ;
- +11 SET DFN=$GET(DFN)
- SET ZSPSEG=$GET(ZSPSEG)
- +12 if (DFN="")!(ZSPSEG="")
- GOTO SETVSIQ
- +13 IF $PIECE($GET(^DPT(DFN,"VET")),"^")="Y"
- IF ($PIECE(ZSPSEG,HLFS,6)=""!($PIECE(ZSPSEG,HLFS,6)=HLQ))
- SET $PIECE(ZSPSEG,HLFS,6)="U"
- +14 IF $PIECE($GET(^DPT(DFN,"VET")),"^")="N"
- SET $PIECE(ZSPSEG,HLFS,6)=HLQ
- +15 ;
- SETVSIQ QUIT ZSPSEG
- +1 ;
- +2 ;
- +3 ;
- +4 ;The following subroutines all have to do with the validation of
- +5 ;data using the same edit checks that are used by Austin.
- +6 ;
- HL7SEGNM(SEG,DATA) ;checks the validity of the HL7 segment name passed in.
- +1 ;INPUT SEG - the HL7 segment name
- +2 ; DATA - the data to compare. In this case the HL7 segment name.
- +3 ;
- +4 ;OUTPUT 0 (ZERO) if not validate
- +5 ; 1 if validated
- +6 ;
- +7 IF '$DATA(SEG)!('$DATA(DATA))
- QUIT 0
- +8 QUIT $SELECT(SEG=DATA:1,1:0)
- +9 ;
- EVTTYP(SEG,DATA) ;checks the event type of the segment passed in.
- +1 ;INPUT SEG - The HL7 segment name in question
- +2 ; DATA - The event type from the HL7 segment in question.
- +3 ;
- +4 ;OUTPUT 0 (ZERO) if not validate
- +5 ; 1 if validated
- +6 ;
- +7 IF '$DATA(SEG)!('$DATA(DATA))
- QUIT 0
- +8 IF SEG="EVN"&(DATA="A08"!(DATA="A23"))
- QUIT 1
- +9 QUIT 0
- +10 ;
- EVTDTTM(DATA) ;Checks the date and time to ensure it is correct.
- +1 ;INPUT DATA - this is the date and time in quesiton.
- +2 ;
- +3 ;OUTPUT 0 (ZERO) if not validate
- +4 ; 1 if validated
- +5 ;
- +6 IF '$DATA(DATA)
- QUIT 0
- +7 NEW STRTDT,%DT,X,Y
- +8 SET STRTDT=+$ORDER(^SD(404.91,0))
- +9 SET STRTDT=$PIECE($GET(^SD(404.91,STRTDT,"AMB")),U,2)
- +10 IF 'STRTDT
- QUIT 0
- +11 SET %DT="T"
- SET %DT(0)=STRTDT
- SET X=DATA
- +12 DO ^%DT
- +13 QUIT $SELECT(Y=-1:0,1:1)
- +14 ;
- VALIDATE(SEG,DATA,ERRCOD,VALERR,CTR) ;
- +1 ;
- +2 NEW ERRIEN,ERRCHK,RES
- +3 SET ERRIEN=+$ORDER(^SD(409.76,"B",ERRCOD,""))
- +4 IF 'ERRIEN
- SET @VALERR@(SEG,CTR)=ERRCOD
- DO INCR
- QUIT
- +5 SET ERRCHK=$GET(^SD(409.76,ERRIEN,"CHK"))
- +6 IF ERRCHK=""
- SET @VALERR@(SEG,CTR)=ERRCOD
- DO INCR
- QUIT
- +7 XECUTE ERRCHK
- +8 IF 'RES
- SET @VALERR@(SEG,CTR)=ERRCOD
- DO INCR
- +9 QUIT
- +10 ;
- DFN(DATA) ;
- +1 ;INPUT DATA - the DFN of the patient
- +2 ;
- +3 IF '$DATA(DATA)
- QUIT 0
- +4 IF DATA=""!(DATA=0)
- QUIT 0
- +5 IF DATA'?1.N.".".N
- QUIT 0
- +6 QUIT 1
- +7 ;
- PATNM(DATA) ;
- +1 ;INPUT DATA - The name of the patient
- +2 ;
- +3 IF '$DATA(DATA)
- QUIT 0
- +4 IF DATA=""
- QUIT 0
- +5 IF DATA?.N.",".N
- QUIT 0
- +6 IF DATA?1.C
- QUIT 0
- +7 QUIT 1
- +8 ;
- DOB(DATA,ENCDT) ;
- +1 ;INPUT DATA - The DOB to be tested.
- +2 ; ENCDT - The date/time of the encounter
- +3 ;
- +4 NEW %DT,X,Y
- +5 IF '$DATA(DATA)
- QUIT 0
- +6 IF '$DATA(ENCDT)
- QUIT 0
- +7 IF DATA'?1.N
- QUIT 0
- +8 SET %DT="T"
- SET %DT(0)=-ENCDT
- SET X=DATA
- +9 DO ^%DT
- +10 QUIT $SELECT(Y=-1:0,1:1)
- +11 ;
- SEX(DATA) ;
- +1 ;INPUT DATA - The sex code to be validated
- +2 ;
- +3 IF '$DATA(DATA)
- QUIT 0
- +4 IF "FMUO"'[DATA
- QUIT 0
- +5 QUIT 1
- +6 ;
- RACE(DATA) ;
- +1 ;INPUT DATA - the race 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
- +11 ;
- STR1(DATA) ;
- +1 ;INPUT DATA - Street address line 1
- +2 ;
- +3 NEW LP,VAR
- +4 IF '$DATA(DATA)
- QUIT 0
- +5 IF DATA=""
- QUIT 0
- +6 IF DATA?1.N
- QUIT 0
- +7 IF DATA=" "
- QUIT 0
- +8 FOR LP=1:1:$LENGTH(DATA)
- SET VAR=$EXTRACT(DATA,LP,LP)
- IF $ASCII(VAR)>32
- IF ($ASCII(VAR)<127)
- SET LP="Y"
- QUIT
- +9 QUIT $SELECT(LP="Y":1,1:0)
- +10 ;
- STR2(DATA) ;
- +1 ;INPUT DATA - Street address line 2
- +2 IF DATA?1.N
- QUIT 0
- +3 QUIT 1
- +4 ;
- CITY(DATA) ;
- +1 ;INPUT DATA - The city code to be validated
- +2 ;
- +3 IF DATA=""
- QUIT 0
- +4 IF DATA?1.N
- QUIT 0
- +5 QUIT 1
- +6 ;
- STATE(DATA) ;
- +1 ;INPUT DATA - State code to be validated.
- +2 ;
- +3 IF '$DATA(DATA)
- QUIT 0
- +4 IF DATA=""
- QUIT 0
- +5 IF '$DATA(^DIC(5,"C",DATA))
- QUIT 0
- +6 QUIT 1
- +7 ;
- ZIP(DATA) ;
- +1 ;INPUT DATA - The zipo code to be validated
- +2 ;
- +3 IF '$DATA(DATA)
- QUIT 0
- +4 IF $EXTRACT(DATA,1,5)="00000"
- QUIT 0
- +5 IF DATA'?5N."-".4N
- QUIT 0
- +6 QUIT 1
- +7 ;
- COUNTY(DATA,STATE) ;
- +1 ;INPUT DATA - The county code to be validated
- +2 ; STATE - STATE file IEN
- +3 ;
- +4 IF DATA=""
- QUIT 0
- +5 IF STATE=""
- QUIT 0
- +6 IF '$DATA(^DIC(5,+$GET(STATE),1,"C",DATA))
- QUIT 0
- +7 QUIT 1
- +8 ;
- MARITAL(DATA) ;
- +1 ;INPUT DATA - The marital status code to be validated.
- +2 ;
- +3 IF $LENGTH(DATA)>1
- QUIT 0
- +4 IF "ADMSWU"'[DATA
- QUIT 0
- +5 QUIT 1
- +6 ;
- REL(DATA) ;
- +1 ;INPUT DATA - The religion abbreviation to the validated
- +2 ;
- +3 IF '$DATA(DATA)
- QUIT 0
- +4 IF DATA=""
- QUIT 0
- +5 IF '$DATA(^DIC(13,"C",+DATA))
- QUIT 0
- +6 QUIT 1
- +7 ;
- SSN(DATA,NOPCHK,NULLOK) ; SD*5.3*345 added optional parameter NULLOK
- +1 ;INPUT DATA - The SSN to be validated
- +2 ; NOPCHK - O = Check pseudo indicator (default)
- +3 ; 1 = Don't check pseudo indicator
- +4 ; NULLOK (optional) - 1 = Allow SSN to be null
- +5 ; 2 = Don't allow null SSNs (default)
- +6 ;
- +7 ; SD*5.3*345
- IF $GET(DATA)=""
- QUIT +$GET(NULLOK)
- +8 IF '$DATA(DATA)
- QUIT 0
- +9 NEW SSN,PSD
- +10 SET SSN=$EXTRACT(DATA,1,9)
- SET PSD=$EXTRACT(DATA,10)
- +11 IF SSN'?9N
- QUIT 0
- +12 IF '$GET(NOPCHK)
- IF (PSD'=" ")
- IF (PSD'="")
- IF (PSD'="P")
- QUIT 0
- +13 IF $EXTRACT(SSN,1,5)="00000"
- QUIT 0
- +14 QUIT 1
- +15 ;
- INCR ;increases the counter
- +1 SET CTR=CTR+1
- +2 QUIT
- +3 ;
- REMOVE(SEG,ERR,VALERR,CNT) ;
- +1 ;INPUT SEG - The segment being worked on
- +2 ; VALERR - The array holding the information
- +3 ; CNT - the counter to use
- +4 ; ERR - error code to remove
- +5 ;
- +6 NEW LP
- +7 FOR LP=1:1:CNT
- IF $GET(@VALERR@(SEG,LP))=ERR
- KILL @VALERR@(SEG,LP)
- +8 QUIT
- +9 ;
- DECR(CNT) ;
- +1 SET CNT=CNT-1
- +2 QUIT
- +3 ;