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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1VAFHLZPD ;ALB/KCL/PHH,TDM - Create generic HL7 ZPD segment ; 7/24/06 10:05am
2 ;;5.3;Registration;**94,122,160,220,247,545,564,568,677,653**;Aug 13, 1993;Build 2
3 ;
4 ;
5EN(DFN,VAFSTR) ; This generic extrinsic function was designed to return
6 ; sequences 1 throught 21 of the HL7 ZPD segment. This segment
7 ; contains VA-specific patient information that is not contained in
8 ; the HL7 PID segment. This call does not accomodate a segment
9 ; length greater than 245 and has been superceeded by EN1^VAFHLZPD.
10 ; This line tag has been left for backwards compatability.
11 ;
12 ;Input - DFN as internal entry number of the PATIENT file
13 ; - VAFSTR as the string of fields requested seperated by commas
14 ; (Defaults to all fields)
15 ;
16 ; *****Also assumes all HL7 variables returned from*****
17 ; INIT^HLTRANS are defined.
18 ;
19 ;Output - String of data forming the ZPD segment.
20 ;
21 ;
22 N VAFY,VAFZPD,REMARKS
23 S VAFY=$$EN1($G(DFN),$G(VAFSTR))
24 ;Segment less than 245 characters
25 I ('$D(VAFZPD(1))) D
26 .;Remove sequences 22 and higher
27 .S VAFY=$P(VAFY,HLFS,1,22)
28 ;Segment greater than 245 characters
29 I ($D(VAFZPD(1))) D
30 .;Strip out REMARKS (seq 2)
31 .S REMARKS=$P(VAFY,HLFS,3)
32 .S $P(VAFY,HLFS,3)=""
33 .;Append up to sequence 21 (PRIMARY CARE TEAM)
34 .S VAFY=VAFY_$P(VAFZPD(1),HLFS,1,((21-$L(VAFY,HLFS))+2))
35 .;Place REMARKS back into segment, truncating if needed
36 .S $P(VAFY,HLFS,3)=$E(REMARKS,1,(245-$L(VAFY)))
37 ;Done
38 Q VAFY
39 ;
40EN1(DFN,VAFSTR) ; This generic extrinsic function was designed to return the
41 ; HL7 ZPD segment. This segment contains VA-specific patient
42 ; information that is not contained in the HL7 PID segment. This
43 ; call superceeds EN^VAFHLZPD because it accomodates a segment
44 ; length greater than 245.
45 ;
46 ;
47 ;Input : DFN - Pointer to PATIENT file (#2)
48 ; VAFSTR - List of data elements to retrieve seperated
49 ; by commas (ex: 1,2,3)
50 ; - Defaults to all data elements
51 ; Existance of HL7 encoding variables is assumed
52 ; (HLFS, HLENC, HLQ)
53 ;Output : ZPD segment
54 ; : If the ZPD segment becomes longer than 245 characters,
55 ; remaining fields will be placed in VAFZPD(1)
56 ;Notes : Sequence 1 (Set ID) will always have a value of '1'
57 ; : A ZPD segment with sequence one set to '1' will be returned
58 ; if DFN is not valid
59 ; : Variable VAFZPD is initialized on entry
60 ;
61 ;Declare variables
62 N VAFHLZPD,VAFY,SEQ,SPILL,SPILLON,SPOT,LASTSEQ,MAXLEN
63 K VAFZPD
64 S MAXLEN=245
65 ;Get data
66 D GETDATA($G(DFN),$G(VAFSTR),"VAFHLZPD")
67 ;Build segment
68 S VAFY="VAFHLZPD"
69 S SPILL=0
70 S SPILLON=0
71 S @VAFY="ZPD"
72 S LASTSEQ=+$O(VAFHLZPD(""),-1)
73 F SEQ=1:1:LASTSEQ D
74 .;Make sure maximum length won't be exceeded
75 .I ($L(@VAFY)+$L($G(VAFHLZPD(SEQ)))+1)>MAXLEN D
76 ..;Max length exceeded - start putting data on next node
77 ..S SPILL=SPILL+1
78 ..S SPILLON=SEQ-1
79 ..S VAFY=$NA(VAFZPD(SPILL))
80 .;Add to string
81 .S SPOT=(SEQ+1)-SPILLON
82 .S $P(@VAFY,HLFS,SPOT)=$G(VAFHLZPD(SEQ))
83 ;Return segment
84 Q VAFHLZPD
85 ;
86GETDATA(DFN,VAFSTR,ARRAY) ;Get info needed to build segment
87 ;Input : DFN - Pointer to PATIENT file (#2)
88 ; VAFSTR - List of data elements to retrieve seperated
89 ; by commas (ex: 1,2,3)
90 ; - Defaults to all data elements
91 ; ARRAY - Array to return data in (full global reference)
92 ; Defaults to ^TMP($J,"VAFHLZPD")
93 ; Existance of HL7 encoding variables is assumed
94 ; (HLFS, HLENC, HLQ)
95 ;Output : Nothing
96 ; ARRAY(SeqNum) = Value
97 ;Notes : ARRAY is initialized (KILLed) on entry
98 ; : Sequence 1 (Set ID) will always have a value of '1'
99 ;
100 ;Check input
101 S ARRAY=$G(ARRAY)
102 S:(ARRAY="") ARRAY=$NA(^TMP($J,"VAFHLZPD"))
103 K @ARRAY
104 ;Sequence 1 - Set ID
105 ; value is always '1'
106 S @ARRAY@(1)=1
107 S DFN=+$G(DFN)
108 S VAFSTR=$G(VAFSTR)
109 S:(VAFSTR="") VAFSTR=$$COMMANUM(1,40)
110 S VAFSTR=","_VAFSTR_","
111 ;Declare variables
112 N VAFNODE,VAPD,X1,X
113 ;Get zero node
114 S VAFNODE=$G(^DPT(DFN,0))
115 ;Get other patient data from VADPT
116 D OPD^VADPT
117 ;Sequence 2 - Remarks (truncate to 60 characters)
118 I VAFSTR[",2," S X=$P(VAFNODE,"^",10),@ARRAY@(2)=$S(X="":HLQ,1:$E(X,1,60))
119 ;Sequence 3 - Place of birth (city)
120 I VAFSTR[",3," S @ARRAY@(3)=$S(VAPD(1)]"":VAPD(1),1:HLQ)
121 ;Sequence 4 - Place of birth (State abbrv.)
122 I VAFSTR[",4," S X1=$P($G(^DIC(5,$P(+VAPD(2),"^",1),0)),"^",2),@ARRAY@(4)=$S(X1]"":X1,1:HLQ)
123 ;Sequence 5 - Current means test status
124 I VAFSTR[",5," S X=$P(VAFNODE,"^",14),X1=$P($G(^DG(408.32,+X,0)),"^",2),@ARRAY@(5)=$S(X1]"":X1,1:HLQ)
125 ;Sequence 6 - Fathers name
126 I VAFSTR[",6," S @ARRAY@(6)=$S(VAPD(3)]"":VAPD(3),1:HLQ)
127 ;Sequence 7 - Mothers name
128 I VAFSTR[",7," S @ARRAY@(7)=$S(VAPD(4)]"":VAPD(4),1:HLQ)
129 ;Sequence 8 - Rated incompetent
130 I VAFSTR[",8," S X1=$$YN^VAFHLFNC($P($G(^DPT(DFN,.29)),"^",12)),@ARRAY@(8)=$S(X1]"":X1,1:HLQ)
131 ;Sequence 9 - Date of Death
132 I VAFSTR[",9," S X=$P($G(^DPT(DFN,.35)),"^",1),X1=$$HLDATE^HLFNC(X),@ARRAY@(9)=$S(X1]"":X1,1:HLQ)
133 ;Sequence 10 - Collateral sponser name
134 I VAFSTR[10 D
135 .S X=$P($G(^DPT(DFN,.36)),"^",11)
136 .S X1=$P($G(^DPT(+X,0)),"^",1)
137 .S @ARRAY@(10)=$S(X1]"":X1,1:HLQ)
138 ;Sequence 11 - Active Health Insurance?
139 I VAFSTR[11 S X=$$INS^VAFHLFNC(DFN),X1=$$YN^VAFHLFNC(X),@ARRAY@(11)=$S(X1]"":X1,1:HLQ)
140 ;Sequences 12 & 13
141 I VAFSTR[12!(VAFSTR[13) D
142 .S X=$G(^DPT(DFN,.38))
143 .;Sequence 12 - Eligible for Medicaid
144 .I VAFSTR[12 S X1=$$YN^VAFHLFNC($P(X,"^",1)),@ARRAY@(12)=$S(X1]"":X1,1:HLQ)
145 .;Sequence 13 - Date Medicaid last asked
146 .I VAFSTR[13 S X1=$$HLDATE^HLFNC($P(X,"^",2)),@ARRAY@(13)=$S(X1]"":X1,1:HLQ)
147 ;Sequence 14 - Race
148 I VAFSTR[14 S X=$P(VAFNODE,"^",6) S X1=$P($G(^DIC(10,+X,0)),"^",2),@ARRAY@(14)=$S(X1]"":X1,1:HLQ)
149 ;Sequence 15 - Religious Preference
150 I VAFSTR[15 S X=$P(VAFNODE,"^",8) S X1=$P($G(^DIC(13,+X,0)),"^",4),@ARRAY@(15)=$S(X1]"":X1,1:HLQ)
151 ;Sequence 16 - Homeless Indicator
152 I VAFSTR[16 S X=$T(HOMELESS^SOWKHIRM) S @ARRAY@(16)=$S(X]"":$$HOMELESS^SOWKHIRM(DFN),1:HLQ)
153 ;Sequences 17 & 20
154 I ((VAFSTR[17)!(VAFSTR[20)) D
155 .;POW Status & Location
156 .N VAF52,POW,LOC
157 .S VAF52=$G(^DPT(DFN,.52))
158 .;POW Status Indicated?
159 .S POW=$P(VAF52,"^",5)
160 .S:(POW="") POW=HLQ
161 .;POW Confinement Location (translates pointer to coded value)
162 .S LOC=$P(VAF52,"^",6)
163 .S:(LOC="") LOC=HLQ
164 .I (LOC'=HLQ) S LOC=$S(LOC>0&(LOC<7):LOC+3,LOC>6&(LOC<9):$C(LOC+58),1:"")
165 .;Add to output array
166 .;Sequence 17 - POW Status
167 .S:(VAFSTR[17) @ARRAY@(17)=POW
168 .;Sequence 20 - POW Confinement Location
169 .S:(VAFSTR[20) @ARRAY@(20)=LOC
170 ;Sequence 18 - Insurance Type
171 I VAFSTR[18 S X=+$$INSTYP^IBCNS1(DFN),@ARRAY@(18)=$S(X]"":X,1:HLQ)
172 ;Sequence 19 - RX Copay Exemption Status
173 I VAFSTR[19 S X=+$$RXST^IBARXEU(DFN),@ARRAY@(19)=$S(X'<0:X,1:HLQ)
174 ;Sequence 21 - Primary Care Team
175 I (VAFSTR[21) D
176 .;Get Primary Care Team (as defined in PCMM)
177 .S X=$$PCTEAM^DGSDUTL(DFN)
178 .S X=$P(X,"^",2)
179 .S:(X="") X=HLQ
180 .;Put into output array
181 .S @ARRAY@(21)=X
182 ;
183 ; Sequences 22 thru 30 added by DG*5.3*264 (Smart Card)
184 ;
185 ; Sequences 22 & 23
186 I VAFSTR[22!(VAFSTR[23) D
187 .; GI Insurance
188 .S X=$G(^DPT(DFN,.362))
189 .I VAFSTR[22 S X1=$P(X,U,17),@ARRAY@(22)=$S(X1="U":"N",X1]"":X1,1:HLQ)
190 .I VAFSTR[23 S X1=$P(X,U,6),@ARRAY@(23)=$S(X1:$E(X1,1,6),1:HLQ)
191 ; Sequences 24 through 27
192 I VAFSTR[24!(VAFSTR[25)!(VAFSTR[26)!(VAFSTR[27) D
193 .; Most recent care dates & locations
194 .S X=$G(^DPT(DFN,1010.15))
195 .I VAFSTR[24 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(24)=$S(X1]"":X1,1:HLQ)
196 .I VAFSTR[25 S X1=$P(X,U,2),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(25)=$S(X1]"":X1,1:HLQ)
197 .I VAFSTR[26 S X1=$$HLDATE^HLFNC($P(X,U,3)),@ARRAY@(26)=$S(X1]"":X1,1:HLQ)
198 .I VAFSTR[27 S X1=$P(X,U,4),X1=$P($G(^DIC(4,+X1,0)),U),@ARRAY@(27)=$S(X1]"":X1,1:HLQ)
199 ; Sequences 28 & 29
200 I VAFSTR[28!(VAFSTR[29) D
201 .; dates ruled incompetent (civil and VA)
202 .S X=$G(^DPT(DFN,.29))
203 .I VAFSTR[28 S X1=$$HLDATE^HLFNC($P(X,U,2)),@ARRAY@(28)=$S(X1]"":X1,1:HLQ)
204 .I VAFSTR[29 S X1=$$HLDATE^HLFNC($P(X,U)),@ARRAY@(29)=$S(X1]"":X1,1:HLQ)
205 ; Sequence 30 - Spinal cord injury
206 I VAFSTR[30 S X=$P($G(^DPT(DFN,57)),U,4),@ARRAY@(30)=$S(X]"":X,1:HLQ)
207 ; Sequence 31 - Source of Notification
208 I VAFSTR[9&(VAFSTR[31) S X=$P($G(^DPT(DFN,.35)),U,3),@ARRAY@(31)=$S(X]"":X,1:HLQ)
209 ; Sequence 32 - Date/Time Last Updated
210 I VAFSTR[9&(VAFSTR[32) S X=$P($G(^DPT(DFN,.35)),U,4),X1=$$HLDATE^HLFNC(X),@ARRAY@(32)=$S(X1]"":X1,1:HLQ)
211 ; Sequence 33 - Filipino Veteran Proof
212 I VAFSTR[33 S X=$P($G(^DPT(DFN,.321)),U,14),@ARRAY@(33)=$S(X]"":X,1:HLQ)
213 ; Sequence 34 - Pseudo SSN Reason - Veteran
214 I VAFSTR[34 S X=$P($G(^DPT(DFN,"SSN")),U),@ARRAY@(34)=$S(X]"":X,1:HLQ)
215 ; Sequence 40 - Emergency Response Indicator
216 I VAFSTR[40 S X=$P($G(^DPT(DFN,.18)),U),@ARRAY@(40)=$S(X]"":X,1:HLQ)
217 ;Done - cleanup & quit
218 D KVA^VADPT
219 Q
220 ;
221COMMANUM(FROM,TO) ;Build comma seperated list of numbers
222 ;Input : FROM - Starting number (default = 1)
223 ; TO - Ending number (default = FROM)
224 ;Output : Comma seperated list of numbers between FROM and TO
225 ; (Ex: 1,2,3)
226 ;Notes : Call assumes FROM <= TO
227 ;
228 S FROM=$G(FROM) S:(FROM="") FROM=1
229 S TO=$G(TO) S:(TO="") TO=FROM
230 N OUTPUT,X
231 S OUTPUT=FROM
232 F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
233 Q OUTPUT
Note: See TracBrowser for help on using the repository browser.