source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VPID.m@ 1535

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1LA7VPID ;DALOI/JMC - HL7 PID/PV1 segment builder utility ; 11-25-1998
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ;
4 ; Reference to routine $$EN^VAFHLPID supported by DBIA# 263
5 ;
6PID(LRDFN,LA7EXTID,LA7ARRAY,LA7PIDSN,HL,LA7ALTID) ; Build PID segment
7 ; Call with LRDFN = Lab DFN, passed by value
8 ; LA7EXTID = to return as external patient id, id used by non-VA systems (optional)
9 ; LA7ARRAY = array to return PID array, pass by reference
10 ; LA7PIDSN = PID id counter, passsed by value
11 ; HL = HL7 variable array, pass by reference
12 ; LA7ALTID = return alternate patient id, id used by non-va systems (optional)
13 ;
14 ; Returns LA7ARRAY
15 ;
16 N DFN,HLQ,LA763,LA7Y,LRDPF,VAFPID
17 ;
18 ; Change HLQ - VAFHLPID puts delete indicator when Vista has no value for field - not according to standard.
19 S HLQ=""
20 ;
21 I $G(LRDFN)=""!($G(HL("FS"))="") Q
22 I '$D(^LR(LRDFN,0)) Q
23 ;
24 S LA7EXTID=$G(LA7EXTID),LA7ALTID=$G(LA7ALTID),LA7PIDSN=$G(LA7PIDSN)+1
25 S LA763(0)=$G(^LR(LRDFN,0))
26 S LRDPF=$P(LA763(0),"^",2),DFN=$P(LA763(0),"^",3)
27 ;
28 ; REFERRAL file (#67) with PATIENT file (#2) link, use info from PATIENT file.
29 I LRDPF=67,$P($G(^LRT(67,DFN,"DPT")),"^") D
30 .S LRDPF=2
31 . S DFN=$P($G(^LRT(67,DFN,"DPT")),"^")
32 ;
33 ; Patient file - use VAF call
34 I LRDPF=2 D F2PID
35 ;
36 ; Non-patient file
37 I LRDPF'=2 D NF2PID
38 K AGE,PNM,SEX,DOB,SSN,VA200,LRWRD,LRRB,LRTREA,VA
39 Q
40 ;
41 ;
42PV1(LRDFN,LA7ARRAY,LA7FS,LA7ECH) ; Build PV1 segment
43 ; Call with LRDFN = ien of entry in File #63
44 ; LA7ARRAY = array to return PV1 array, pass by reference
45 ; LA7FS = HL field separator
46 ; LA7ECH = HL encoding characters
47 ;
48 ;
49 N DFN,LA763,LA7LOC,LRDPF,LA7Y
50 S LA763(0)=$G(^LR(LRDFN,0))
51 S LRDPF=$P(LA763(0),"^",2),DFN=$P(LA763(0),"^",3),LA7LOC=""
52 ;
53 S LA7Y(0)="PV1"
54 S LA7Y(1)=1
55 ;
56 ; Referral file with Patient file link.
57 I LRDPF=67,$P($G(^LRT(67,DFN,"DPT")),"^") D
58 . S LRDPF=2
59 . S DFN=$P($G(^LRT(67,DFN,"DPT")),"^")
60 ;
61 ; Determine patient class
62 ; Current inpatient location
63 I LRDPF=2 S LA7LOC=$G(^DPT(DFN,.1))
64 I $L(LA7LOC) S LA7Y(2)="I" ; Inpatient
65 ;
66 ; Otherwise from lab files
67 I $G(LA7LOC)="" D
68 . S LA7LOC=$G(^LR(LRDFN,.1))
69 . S LA7Y(2)="O" ; Default to outpatient
70 ;
71 ; Patient location
72 S LA7LOC=$$CHKDATA^LA7VHLU3(LA7LOC,LA7FS_LA7ECH)
73 S LA7Y(3)=LA7LOC
74 ;
75 D BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,LA7FS)
76 Q
77 ;
78 ;
79F2PID ; Build patient identifier field on file #2 patient
80 ;
81 N I,ICN,LA7X,X
82 S LA7ARRAY(0)=$$EN^VAFHLPID(DFN,"1,5,6,7,8,10NTB,16,19",LA7PIDSN)
83 ;
84 ; Return external identifer in PID-2 sequence, backward compatibility to V2.2
85 I $L(LA7EXTID) D
86 . I '(LA7EXTID?1N.N) S $P(LA7ARRAY(0),HL("FS"),3)=LA7EXTID
87 . E S $P(LA7ARRAY(0),HLFS,3)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
88 ;
89 ; Send SSN as patient identifier
90 S X=$$M11^HLFNC($P(LA7ARRAY(0),HLFS,20),HL("ECH"))
91 S $P(X,$E(HL("ECH")),5)="SS"
92 S $P(LA7ARRAY(0),HLFS,4)=X
93 ;
94 ; Send DFN as patient identifier
95 S X=$$M11^HLFNC(DFN,HL("ECH"))
96 S $P(X,$E(HL("ECH")),5)="PI"
97 S $P(X,$E(HL("ECH")),6)=$$GET1^DIQ(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)_$E(HL("ECH"),4)_$G(^XMB("NETNAME"))_$E(HL("ECH"),4)_"DNS"
98 S $P(LA7ARRAY(0),HLFS,4)=$P(LA7ARRAY(0),HL("FS"),4)_$E(HL("ECH"),2)_X
99 ;
100 ; Send ICN from MPI as patient identifier
101 S ICN=$$ICN(DFN,HL("ECH"))
102 I ICN>0 S $P(LA7ARRAY(0),HLFS,4)=$P(LA7ARRAY(0),HL("FS"),4)_$E(HL("ECH"),2)_ICN
103 ;
104 ; Send alternate patient id if passed
105 I LA7ALTID'="" S $P(LA7ARRAY(0),HL("FS"),5)=LA7ALTID
106 I $P(LA7ARRAY(0),HLFS,5)?1N.N S $P(LA7ARRAY(0),HL("FS"),5)=$$M11^HLFNC($P(LA7ARRAY(0),HL("FS"),5),HL("ECH"))
107 ;
108 ; Check for overflow (>245)
109 I $O(VAFPID(0)) D
110 . S I=0
111 . F S I=$O(VAFPID(I)) Q:'I S LA7ARRAY(I)=VAFPID(I)
112 ;
113 Q
114 ;
115 ;
116NF2PID ; Build patient identifier field on non-file #2 patient
117 ;
118 D PT^LRX
119 S LA7Y(0)="PID"
120 S LA7Y(1)=LA7PIDSN
121 ;
122 ; Return external identifer in PID-2 sequence, backward compatibility to V2.2
123 I LA7EXTID'="" D
124 . I '(LA7EXTID?1N.N) S LA7Y(2)=LA7EXTID
125 . E S LA7Y(2)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
126 S LA7Y(3)=$$M11^HLFNC(SSN(2),HL("ECH"))
127 I LRDPF=67.1 S $P(LA7Y(3),$E(HL("ECH"),1),5)="L2"
128 ;
129 ; Send LRDFN as alternate patient ID, unless alternate id passed
130 I LA7ALTID'="" S LA7Y(4)=LA7ALTID
131 E S LA7Y(4)=LRDFN
132 I LA7Y(4)?1N.N S LA7Y(4)=$$M11^HLFNC(LA7Y(4),HL("ECH"))
133 ;
134 S LA7Y(5)=$$HLNAME^HLFNC($G(PNM),HL("ECH"))
135 ;
136 I $G(DOB)'="" D
137 . S DOB=$$CHKDT^LA7VHLU1(DOB)
138 . S LA7Y(7)=$$FMTHL7^XLFDT(DOB)
139 ;
140 S LA7Y(8)=$S($G(SEX)'="":SEX,1:"U")
141 ;
142 ; Race - if from REFERRAL PATIENT file (#67) then check RACE field.
143 S LA7Y(10)=""
144 I LRDPF=67 D
145 . S LA7X=$$GET1^DIQ(67,DFN_",",.06,"I")
146 . I LA7X<1 Q
147 . S LA7Y(10)=$$PTR2CODE^DGUTL4(LA7X,1,2)
148 . S $P(LA7Y(10),$E(HL("ECH"),1),2)=$$PTR2TEXT^DGUTL4(LA7X,1)
149 . S $P(LA7Y(10),$E(HL("ECH"),1),3)="HL70005"
150 ;
151 ; SSN from referral file if 9N - DoD uses PID-19 to validate
152 S LA7Y(19)=""
153 I LRDPF=67 D
154 . S LA7X=$$GET1^DIQ(67,DFN_",",.09,"I")
155 . I LA7X?9N S LA7Y(19)=LA7X
156 ;
157 D BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,HL("FS"))
158 Q
159 ;
160 ;
161ICN(DFN,LA7ECH) ; Send ICN from MPI
162 ; Call with DFN = internal entry number of patient in PATIENT #2 file.
163 ; LA7ECH = HL7 encoding characters.
164 ;
165 N ICN,LA7ICN
166 ;
167 S ICN=""
168 ;
169 S X="MPIF001" X ^%ZOSF("TEST")
170 I $T D
171 . S LA7ICN=$$GETICN^MPIF001(DFN)
172 . I LA7ICN<1 Q
173 . S ICN=LA7ICN
174 . S $P(ICN,$E(LA7ECH,1),4)="USVHA"_$E(LA7ECH,4)_$E(LA7ECH,4)_"HL70363"
175 . S $P(ICN,$E(LA7ECH,1),5)="NI"
176 . S $P(ICN,$E(LA7ECH,1),6)="VA FACILITY ID"_$E(LA7ECH,4)_$P($$SITE^VASITE,"^",3)_$E(LA7ECH,4)_"L"
177 ;
178 Q ICN
Note: See TracBrowser for help on using the repository browser.