- VAFHLPID ;ALB/MLI/ESD - Create generic PID segment ; 21 Nov 2002 3:13 PM
- ;;5.3;Registration;**68,94,415,508,749**;Aug 13, 1993;Build 10
- ;
- ; This routine returns the HL7 defined PID segment with its
- ; mappings to DHCP PATIENT file fields.
- ;
- EN(DFN,VAFSTR,VAFNUM,PTID) ; returns PID segment
- ; Input - DFN as internal entry number of the PATIENT file
- ; VAFSTR as string of fields requested separated by commas
- ; VAFNUM as sequential number for SET ID (default=1)
- ; PTID is flag denoting which Patient ID (seq 3) to use
- ; 0 - Use DFN formatted as data type CK (default)
- ; 1 - Use ICN
- ; 2 - Use DFN formatted as data type CX
- ; 3 - Use SSN (with dashes)
- ;
- ; ****Also assumes all HL7 variables returned from****
- ; INIT^HLTRANS are defined
- ;
- ; Output - String containing the desired components of the PID segment
- ; VAFPID(n) - if the string is longer than 245, the remaining
- ; characters will be returned in VAFPID(n) where
- ; n is a sequential number beginning with 1
- ;
- ; WARNING: This routine makes external calls to VADPT. Non-namespaced
- ; variables may be altered.
- ;
- N I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,DGMMN,VAPA ; calls VADPT...have to NEW
- S VAFSTR=$G(VAFSTR) ; if not defined, just return required fields
- S DFN=$G(DFN)
- I DFN']"" G QUIT
- ;Get demographics and permanent address
- S VAPA("P")="" D 4^VADPT
- S VAFSTR=","_VAFSTR_","
- K VAFY
- ;Set ID (#1)
- I VAFSTR[",1," S VAFY(1)=$S($G(VAFNUM):VAFNUM,1:1)
- ;External ID (#2)
- I VAFSTR[",2," S X=$G(VA("PID")),VAFY(2)=$S(X]"":$$M10^HLFNC(X),1:HLQ)
- ;Patient ID (#3 - req)
- S PTID=+$G(PTID)
- I 'PTID S VAFY(3)=$$M10^HLFNC(DFN)
- I PTID D
- .S X=$S(PTID=1:"NI",PTID=2:"PI",PTID=3:"SS")
- .S VAFY(3)=$$SEQ3^VAFHLPI1(DFN,X,HLECH,HLQ)
- ;Alternate ID (#4)
- I VAFSTR[",4," S X=$G(VA("BID")),VAFY(4)=$S(X]"":X,1:HLQ)
- ;Name (#5 - req)
- S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01
- S X=$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH)),VAFY(5)=$S(X]"":X,1:HLQ)
- ;Mother's maiden name (#6)
- I VAFSTR[",6," D
- .S DGMMN("FILE")=2,DGMMN("IENS")=DFN,DGMMN("FIELD")=.2403
- .S X=$$HLNAME^XLFNAME(.DGMMN,"",$E(HLECH)),VAFY(6)=$S(X]"":X,1:HLQ)
- ;Date of birth (#7)
- I VAFSTR[",7," S VAFY(7)=$$HLDATE^HLFNC(+VADM(3))
- ;Sex (#8)
- I VAFSTR[",8," S X=$P(VADM(5),"^",1),VAFY(8)=$S("^M^F^"[("^"_X_"^"):X,1:"U")
- ;Race (#10)
- I VAFSTR[10 D
- .N HOW
- .S Y=$F(VAFSTR,"10")
- .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
- .D SEQ10^VAFHLPI1(HOW,HLQ)
- ;Address (#11)
- I VAFSTR[11 D
- .N HOW
- .S Y=$F(VAFSTR,"11")
- .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
- .D SEQ11^VAFHLPI2(HOW,HLQ)
- ;County (#12)
- I VAFSTR[12 S X1=$P($G(^DIC(5,+$G(VAPA(5)),1,+$G(VAPA(7)),0)),"^",3),VAFY(12)=$S(X1]"":X1,1:HLQ)
- S X=$G(^DPT(DFN,.13))
- ;Home phone (#13)
- I VAFSTR[13 S X1=$$HLPHONE^HLFNC($P(X,"^",1)),VAFY(13)=$S(X1]"":X1,1:HLQ)
- ;Business phone (#14)
- I VAFSTR[14 S X1=$$HLPHONE^HLFNC($P(X,"^",2)),VAFY(14)=$S(X1]"":X1,1:HLQ)
- ;Marital status (#16)
- I VAFSTR[16 S X=$P($G(^DIC(11,+VADM(10),0)),"^",3),VAFY(16)=$S(X="N":"S",X="U":"",X="":HLQ,1:X)
- ;Religious preference (#17) (if blank send 29 (UNKNOWN))
- I VAFSTR[17 S X=$P($G(^DIC(13,+VADM(9),0)),"^",4),VAFY(17)=$S(X]"":X,1:29)
- ;SSN (#19)
- I VAFSTR[19 S X=$P(VADM(2),"^",1),VAFY(19)=$S(X]"":X,1:HLQ)
- ;Ethnicity (#22)
- I VAFSTR[22 D
- .N HOW
- .S Y=$F(VAFSTR,"22")
- .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
- .D SEQ22^VAFHLPI1(HOW,HLQ)
- ;
- QUIT D KVA^VADPT
- D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID)
- Q OUTPUT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLPID 3651 printed Jan 18, 2025@04:03:49 Page 2
- VAFHLPID ;ALB/MLI/ESD - Create generic PID segment ; 21 Nov 2002 3:13 PM
- +1 ;;5.3;Registration;**68,94,415,508,749**;Aug 13, 1993;Build 10
- +2 ;
- +3 ; This routine returns the HL7 defined PID segment with its
- +4 ; mappings to DHCP PATIENT file fields.
- +5 ;
- EN(DFN,VAFSTR,VAFNUM,PTID) ; returns PID segment
- +1 ; Input - DFN as internal entry number of the PATIENT file
- +2 ; VAFSTR as string of fields requested separated by commas
- +3 ; VAFNUM as sequential number for SET ID (default=1)
- +4 ; PTID is flag denoting which Patient ID (seq 3) to use
- +5 ; 0 - Use DFN formatted as data type CK (default)
- +6 ; 1 - Use ICN
- +7 ; 2 - Use DFN formatted as data type CX
- +8 ; 3 - Use SSN (with dashes)
- +9 ;
- +10 ; ****Also assumes all HL7 variables returned from****
- +11 ; INIT^HLTRANS are defined
- +12 ;
- +13 ; Output - String containing the desired components of the PID segment
- +14 ; VAFPID(n) - if the string is longer than 245, the remaining
- +15 ; characters will be returned in VAFPID(n) where
- +16 ; n is a sequential number beginning with 1
- +17 ;
- +18 ; WARNING: This routine makes external calls to VADPT. Non-namespaced
- +19 ; variables may be altered.
- +20 ;
- +21 ; calls VADPT...have to NEW
- NEW I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,DGMMN,VAPA
- +22 ; if not defined, just return required fields
- SET VAFSTR=$GET(VAFSTR)
- +23 SET DFN=$GET(DFN)
- +24 IF DFN']""
- GOTO QUIT
- +25 ;Get demographics and permanent address
- +26 SET VAPA("P")=""
- DO 4^VADPT
- +27 SET VAFSTR=","_VAFSTR_","
- +28 KILL VAFY
- +29 ;Set ID (#1)
- +30 IF VAFSTR[",1,"
- SET VAFY(1)=$SELECT($GET(VAFNUM):VAFNUM,1:1)
- +31 ;External ID (#2)
- +32 IF VAFSTR[",2,"
- SET X=$GET(VA("PID"))
- SET VAFY(2)=$SELECT(X]"":$$M10^HLFNC(X),1:HLQ)
- +33 ;Patient ID (#3 - req)
- +34 SET PTID=+$GET(PTID)
- +35 IF 'PTID
- SET VAFY(3)=$$M10^HLFNC(DFN)
- +36 IF PTID
- Begin DoDot:1
- +37 SET X=$SELECT(PTID=1:"NI",PTID=2:"PI",PTID=3:"SS")
- +38 SET VAFY(3)=$$SEQ3^VAFHLPI1(DFN,X,HLECH,HLQ)
- End DoDot:1
- +39 ;Alternate ID (#4)
- +40 IF VAFSTR[",4,"
- SET X=$GET(VA("BID"))
- SET VAFY(4)=$SELECT(X]"":X,1:HLQ)
- +41 ;Name (#5 - req)
- +42 SET DGNAME("FILE")=2
- SET DGNAME("IENS")=DFN
- SET DGNAME("FIELD")=.01
- +43 SET X=$$HLNAME^XLFNAME(.DGNAME,"",$EXTRACT(HLECH))
- SET VAFY(5)=$SELECT(X]"":X,1:HLQ)
- +44 ;Mother's maiden name (#6)
- +45 IF VAFSTR[",6,"
- Begin DoDot:1
- +46 SET DGMMN("FILE")=2
- SET DGMMN("IENS")=DFN
- SET DGMMN("FIELD")=.2403
- +47 SET X=$$HLNAME^XLFNAME(.DGMMN,"",$EXTRACT(HLECH))
- SET VAFY(6)=$SELECT(X]"":X,1:HLQ)
- End DoDot:1
- +48 ;Date of birth (#7)
- +49 IF VAFSTR[",7,"
- SET VAFY(7)=$$HLDATE^HLFNC(+VADM(3))
- +50 ;Sex (#8)
- +51 IF VAFSTR[",8,"
- SET X=$PIECE(VADM(5),"^",1)
- SET VAFY(8)=$SELECT("^M^F^"[("^"_X_"^"):X,1:"U")
- +52 ;Race (#10)
- +53 IF VAFSTR[10
- Begin DoDot:1
- +54 NEW HOW
- +55 SET Y=$FIND(VAFSTR,"10")
- +56 SET HOW=$PIECE($EXTRACT(VAFSTR,Y,$FIND(VAFSTR,",",Y)),",",1)
- +57 DO SEQ10^VAFHLPI1(HOW,HLQ)
- End DoDot:1
- +58 ;Address (#11)
- +59 IF VAFSTR[11
- Begin DoDot:1
- +60 NEW HOW
- +61 SET Y=$FIND(VAFSTR,"11")
- +62 SET HOW=$PIECE($EXTRACT(VAFSTR,Y,$FIND(VAFSTR,",",Y)),",",1)
- +63 DO SEQ11^VAFHLPI2(HOW,HLQ)
- End DoDot:1
- +64 ;County (#12)
- +65 IF VAFSTR[12
- SET X1=$PIECE($GET(^DIC(5,+$GET(VAPA(5)),1,+$GET(VAPA(7)),0)),"^",3)
- SET VAFY(12)=$SELECT(X1]"":X1,1:HLQ)
- +66 SET X=$GET(^DPT(DFN,.13))
- +67 ;Home phone (#13)
- +68 IF VAFSTR[13
- SET X1=$$HLPHONE^HLFNC($PIECE(X,"^",1))
- SET VAFY(13)=$SELECT(X1]"":X1,1:HLQ)
- +69 ;Business phone (#14)
- +70 IF VAFSTR[14
- SET X1=$$HLPHONE^HLFNC($PIECE(X,"^",2))
- SET VAFY(14)=$SELECT(X1]"":X1,1:HLQ)
- +71 ;Marital status (#16)
- +72 IF VAFSTR[16
- SET X=$PIECE($GET(^DIC(11,+VADM(10),0)),"^",3)
- SET VAFY(16)=$SELECT(X="N":"S",X="U":"",X="":HLQ,1:X)
- +73 ;Religious preference (#17) (if blank send 29 (UNKNOWN))
- +74 IF VAFSTR[17
- SET X=$PIECE($GET(^DIC(13,+VADM(9),0)),"^",4)
- SET VAFY(17)=$SELECT(X]"":X,1:29)
- +75 ;SSN (#19)
- +76 IF VAFSTR[19
- SET X=$PIECE(VADM(2),"^",1)
- SET VAFY(19)=$SELECT(X]"":X,1:HLQ)
- +77 ;Ethnicity (#22)
- +78 IF VAFSTR[22
- Begin DoDot:1
- +79 NEW HOW
- +80 SET Y=$FIND(VAFSTR,"22")
- +81 SET HOW=$PIECE($EXTRACT(VAFSTR,Y,$FIND(VAFSTR,",",Y)),",",1)
- +82 DO SEQ22^VAFHLPI1(HOW,HLQ)
- End DoDot:1
- +83 ;
- QUIT DO KVA^VADPT
- +1 DO MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID)
- +2 QUIT OUTPUT