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

SCMSVUT0.m

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