| [623] | 1 | VAFCPID ;ALB/MLI,PKE-Create generic PID segment ; 21 Nov 2002 3:13 PM
|
|---|
| 2 | ;;5.3;Registration;**91,149,190,415,508**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine returns the HL7 defined PID segment with its
|
|---|
| 5 | ; mappings to DHCP PATIENT file fields.
|
|---|
| 6 | ;
|
|---|
| 7 | EN(DFN,VAFSTR,VAFNUM) ; returns PID segment
|
|---|
| 8 | ; Input - DFN as internal entry number of the PATIENT file
|
|---|
| 9 | ; VAFSTR as string of fields requested separated by commas
|
|---|
| 10 | ; VAFNUM as sequential number for SET ID (default=1)
|
|---|
| 11 | ;
|
|---|
| 12 | ; ****Also assumes all HL7 variables returned from****
|
|---|
| 13 | ; INIT^HLTRANS are defined
|
|---|
| 14 | ;
|
|---|
| 15 | ; Output - String containing the desired components of the PID segment
|
|---|
| 16 | ; VAFPID(n) - if the string is longer than 245, the remaining
|
|---|
| 17 | ; characters will be returned in VAFPID(n) where
|
|---|
| 18 | ; n is a sequential number beginning with 1
|
|---|
| 19 | ;
|
|---|
| 20 | ; WARNING: This routine makes external calls to VADPT. Non-namespaced
|
|---|
| 21 | ; variables may be altered.
|
|---|
| 22 | ;
|
|---|
| 23 | N I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,VAPA ; calls VADPT...have to NEW
|
|---|
| 24 | S VAFSTR=$G(VAFSTR) ; if not defined, just return required fields
|
|---|
| 25 | S DFN=$G(DFN)
|
|---|
| 26 | I DFN']"" G QUIT
|
|---|
| 27 | ;Get demographics and permanent address
|
|---|
| 28 | S VAPA("P")="" D 4^VADPT
|
|---|
| 29 | S VAFSTR=","_VAFSTR_","
|
|---|
| 30 | K VAFY
|
|---|
| 31 | ;Set ID (#1)
|
|---|
| 32 | I VAFSTR[",1," S VAFY(1)=$S($G(VAFNUM):VAFNUM,1:1)
|
|---|
| 33 | ;External ID (#2 - always included)
|
|---|
| 34 | S X=$$GETICN^MPIF001(DFN) S:(+X=-1) X="" S VAFY(2)=$S(X]"":X,1:HLQ)
|
|---|
| 35 | ;Patient ID (#3 - req)
|
|---|
| 36 | S VAFY(3)=$$M10^HLFNC(DFN)
|
|---|
| 37 | ;Alternate ID (#4)
|
|---|
| 38 | I VAFSTR[",4," S X=$G(VA("BID")),VAFY(4)=$S(X]"":X,1:HLQ)
|
|---|
| 39 | ;Name (#5 - req)
|
|---|
| 40 | S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01
|
|---|
| 41 | S X=$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH)),VAFY(5)=$S(X]"":X,1:HLQ)
|
|---|
| 42 | ;Mother's maiden name (#6)
|
|---|
| 43 | I VAFSTR[",6," S X=$P($G(^DPT(DFN,.24)),"^",3),VAFY(6)=$S(X]"":X,1:HLQ)
|
|---|
| 44 | ;Date of birth (#7)
|
|---|
| 45 | I VAFSTR[",7," S VAFY(7)=$$HLDATE^HLFNC(+VADM(3))
|
|---|
| 46 | ;Sex (#8)
|
|---|
| 47 | I VAFSTR[",8," S X=$P(VADM(5),"^",1),VAFY(8)=$S("^M^F^"[("^"_X_"^"):X,1:"U")
|
|---|
| 48 | ;Race (#10)
|
|---|
| 49 | I VAFSTR[10 D
|
|---|
| 50 | .N HOW
|
|---|
| 51 | .S Y=$F(VAFSTR,"10")
|
|---|
| 52 | .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
|
|---|
| 53 | .D SEQ10^VAFHLPI1(HOW,HLQ)
|
|---|
| 54 | ;Address (#11)
|
|---|
| 55 | I VAFSTR[11 D
|
|---|
| 56 | .N HOW
|
|---|
| 57 | .S Y=$F(VAFSTR,"11")
|
|---|
| 58 | .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
|
|---|
| 59 | .D SEQ11^VAFHLPI2(HOW,HLQ)
|
|---|
| 60 | ;County (#12)
|
|---|
| 61 | 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)
|
|---|
| 62 | S X=$G(^DPT(DFN,.13))
|
|---|
| 63 | ;Home phone (#13)
|
|---|
| 64 | I VAFSTR[13 S X1=$$HLPHONE^HLFNC($P(X,"^",1)),VAFY(13)=$S(X1]"":X1,1:HLQ)
|
|---|
| 65 | ;Business phone (#14)
|
|---|
| 66 | I VAFSTR[14 S X1=$$HLPHONE^HLFNC($P(X,"^",2)),VAFY(14)=$S(X1]"":X1,1:HLQ)
|
|---|
| 67 | ;Marital status (#16)
|
|---|
| 68 | I VAFSTR[16 S X=$P($G(^DIC(11,+VADM(10),0)),"^",3),VAFY(16)=$S(X="M":"M",X="N":"S",X="S":"A",X]"":X,1:HLQ)
|
|---|
| 69 | ;Religious preference (#17) (if blank send 29 (UNKNOWN))
|
|---|
| 70 | I VAFSTR[17 S X=$P($G(^DIC(13,+VADM(9),0)),"^",4),VAFY(17)=$S(X]"":X,1:29)
|
|---|
| 71 | ;SSN (#19)
|
|---|
| 72 | I VAFSTR[19 S X=$P(VADM(2),"^",1),VAFY(19)=$S(X]"":X,1:HLQ)
|
|---|
| 73 | ;Ethnicity (#22)
|
|---|
| 74 | I VAFSTR[22 D
|
|---|
| 75 | .N HOW
|
|---|
| 76 | .S Y=$F(VAFSTR,"22")
|
|---|
| 77 | .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
|
|---|
| 78 | .D SEQ22^VAFHLPI1(HOW,HLQ)
|
|---|
| 79 | ;Birth place (#23)
|
|---|
| 80 | I VAFSTR[23 D
|
|---|
| 81 | .N DGBC,DGBS
|
|---|
| 82 | .S DGBC=$$GET1^DIQ(2,DFN,.092,"I")
|
|---|
| 83 | .S DGBS=$$GET1^DIQ(2,DFN,.093,"E")
|
|---|
| 84 | .S VAFY(23)=DGBC_" "_DGBS
|
|---|
| 85 | ;Date of death (#29) & Death indicator (#30) (always included if dead)
|
|---|
| 86 | S X=+VADM(6) I X D
|
|---|
| 87 | .S VAFY(29)=$$HLDATE^HLFNC(X)
|
|---|
| 88 | .S VAFY(30)="Y"
|
|---|
| 89 | ;
|
|---|
| 90 | QUIT D KVA^VADPT
|
|---|
| 91 | D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID)
|
|---|
| 92 | Q OUTPUT
|
|---|
| 93 | ;
|
|---|
| 94 | ADDR(VAFADDR,VAFCOUNT) ;Return HL7 address
|
|---|
| 95 | ; Input - VAFADDR as address in format:
|
|---|
| 96 | ; line1^line2^line3^city^state^zip+4
|
|---|
| 97 | ; VAFCOUNT as internal value of county (optional)
|
|---|
| 98 | ; Output - HL7 v2.3 formatted Address_HLFS_County Code
|
|---|
| 99 | ;
|
|---|
| 100 | ; ****Also assumes all HL7 variables returned from****
|
|---|
| 101 | ; INIT^HLTRANS are defined
|
|---|
| 102 | ;
|
|---|
| 103 | N X,Y,Z S X=$E(HLECH)
|
|---|
| 104 | ;Street address (line 1)
|
|---|
| 105 | S $P(Y,X,1)=$P(VAFADDR,"^",1)
|
|---|
| 106 | ;Other designation (line 2)
|
|---|
| 107 | S $P(Y,X,2)=$P(VAFADDR,"^",2)
|
|---|
| 108 | ;City
|
|---|
| 109 | S $P(Y,X,3)=$P(VAFADDR,"^",4)
|
|---|
| 110 | ;State
|
|---|
| 111 | S $P(Y,X,4)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),0)),"^",2)
|
|---|
| 112 | ;Zip
|
|---|
| 113 | S $P(Y,X,5)=$P(VAFADDR,"^",6)
|
|---|
| 114 | ;Other geographic designation (line 3)
|
|---|
| 115 | S $P(Y,X,8)=$P(VAFADDR,"^",3)
|
|---|
| 116 | ;County
|
|---|
| 117 | S $P(Y,X,9)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),1,+$G(VAFCOUNT),0)),"^",3)
|
|---|
| 118 | F Z=1,2,3,4,5,8,9 I $P(Y,X,Z)="" S $P(Y,X,Z)=HLQ
|
|---|
| 119 | I $G(VAFCOUNT) D
|
|---|
| 120 | .S $P(Y,HLFS,2)=$P(Y,X,9)
|
|---|
| 121 | Q Y
|
|---|
