source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCPID.m@ 1141

Last change on this file since 1141 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 4.2 KB
Line 
1VAFCPID ;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 ;
7EN(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 ;
90QUIT D KVA^VADPT
91 D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID)
92 Q OUTPUT
93 ;
94ADDR(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
Note: See TracBrowser for help on using the repository browser.