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

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

initial load of WorldVistAEHR
File size: 5.8 KB
Line 
1VAFHLZE1 ;BPFO/JRP,TDM - Data extractor for ZEL segment ; 5/24/06 3:43pm
2 ;;5.3;Registration;**342,497,602,672,653**;Aug 13, 1993;Build 2
3 ;
4GETDATA ;Get information needed to build ZEL segment
5 ;Input: Existance of the following variables is assumed
6 ; DFN - Pointer to Patient (#2) file
7 ; VAFPELIG - Primary Eligibility string (.36 node)
8 ; VAFSTR - Fields to extract (padded with commas)
9 ; VAFNODE - Eligibility Node (node from Elig. ["E"] mult)
10 ; VAFMSTDT - Date to use when getting MST status (optional)
11 ; VAFSETID - Value to use for Set ID (optional)
12 ; HL7 encoding characters (HLFS, HLENC, HLQ)
13 ;
14 ;Output: VAFHLZEL(SeqNum) = Value
15 ;
16 ;Notes: VAFHLZEL is initialized (KILLed) on entry
17 ; : If not passed, sequence 1 (Set ID) will have a value of '1'
18 ; if getting data for the primary eligibility and '2' if getting
19 ; data for other eligibility
20 ; : All requested fields will be returned with the primary
21 ; eligibility. The Set ID (seq 1), eligibility code (seq 2)
22 ; long ID (seq 3), and short ID (seq 4) will be the only fields
23 ; returned for all other eligibilities.
24 ;
25 N PRIME,VAF,VAFMST,X
26 K VAFHLZEL
27 ;If true, primary eligibility (return all fields)
28 S PRIME=+VAFNODE=+VAFPELIG
29 ;Set ID
30 I VAFSTR[",1," S VAFHLZEL(1)=$S($G(VAFSETID):VAFSETID,PRIME:1,1:2)
31 ;Eligibility Code
32 I VAFSTR[",2," S X=$P($G(^DIC(8,+VAFNODE,0)),"^",9),VAFHLZEL(2)=$S(X]"":X,1:HLQ)
33 ;Long ID
34 I VAFSTR[",3," S X=$P(VAFNODE,"^",3),VAFHLZEL(3)=$S(X]"":$$M10^HLFNC(X),1:HLQ)
35 ;Short ID
36 I VAFSTR[",4," S X=$P(VAFNODE,"^",4),VAFHLZEL(4)=$S(X]"":X,1:HLQ)
37 ;Done if not getting primary eligibility information
38 I 'PRIME D Q
39 .N Y,Z
40 .S Y=$L(VAFSTR,",")
41 .F X=1:1:Y S Z=$P(VAFSTR,",",X) I Z S:(Z>4) VAFHLZEL(Z)=HLQ
42 ;Get needed nodes in Patient file (#2)
43 N VAF
44 F X=.3,.31,.321,.322,.362,.361 S VAF(X)=$G(^DPT(DFN,X))
45 ;Military Disability Retirement
46 I VAFSTR[",5," S X=$P(VAFPELIG,"^",12),VAFHLZEL(5)=$S(X=0:"N",X=1:"Y",1:HLQ)
47 ;Claim Number
48 I VAFSTR[",6," S X=$P(VAF(.31),"^",3),VAFHLZEL(6)=$S(X]"":X,1:HLQ)
49 ;Claim Folder Loc
50 I VAFSTR[",7," S X=$P(VAF(.31),"^",2),VAFHLZEL(7)=$S(X]"":X,1:HLQ)
51 ;Veteran?
52 I VAFSTR[",8," S X=$P($G(^DPT(DFN,"VET")),"^"),VAFHLZEL(8)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
53 ;Type
54 I VAFSTR[",9," S X=$P($G(^DG(391,+$P($G(^DPT(DFN,"TYPE")),"^"),0)),"^"),VAFHLZEL(9)=$S(X]"":X,1:HLQ)
55 ;Elig Status
56 I VAFSTR[10 S X=$P(VAF(.361),"^",1),VAFHLZEL(10)=$S(X]"":X,1:HLQ)
57 ;Elig Status Date
58 I VAFSTR[11 S X=$P(VAF(.361),"^",2),VAFHLZEL(11)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
59 ;Elig Interim Response
60 I VAFSTR[12 S X=$P(VAF(.361),"^",4),VAFHLZEL(12)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
61 ;Elig Verif. Method
62 I VAFSTR[13 S X=$P(VAF(.361),"^",5),VAFHLZEL(13)=$S(X]"":X,1:HLQ)
63 ;Rec A&A Benefits?
64 I VAFSTR[14 S X=$P(VAF(.362),"^",12),VAFHLZEL(14)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
65 ;Rec Housebound Benefits?
66 I VAFSTR[15 S X=$P(VAF(.362),"^",13),VAFHLZEL(15)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
67 ;Rec VA Pension?
68 I VAFSTR[16 S X=$P(VAF(.362),"^",14),VAFHLZEL(16)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
69 ;Rec VA Disability?
70 I VAFSTR[17 S X=$P(VAF(.3),"^",11),VAFHLZEL(17)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
71 ;Agent Orange Expos. Indicated?
72 I VAFSTR[18 S X=$P(VAF(.321),"^",2),VAFHLZEL(18)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
73 ;Radiation Expos. Indicated?
74 I VAFSTR[19 S X=$P(VAF(.321),"^",3),VAFHLZEL(19)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
75 ;Environmental Contaminants?
76 I VAFSTR[20 S X=$P(VAF(.322),"^",13),VAFHLZEL(20)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
77 ;Total Annual VA Check Amount
78 I VAFSTR[21 S X=$P(VAF(.362),"^",20),VAFHLZEL(21)=$S(X]"":X,1:HLQ)
79 ;Radiation Exposure Method
80 I (VAFSTR[22) D
81 .S X=$P(VAF(.321),"^",12)
82 .S:(X="")!($L(X)>1) X=HLQ
83 .S:(X'=HLQ) X=$TR(X,"NTB","234")
84 .S VAFHLZEL(22)=X
85 ;Call MST status API
86 S VAFMST=$$GETSTAT^DGMSTAPI(DFN,$G(VAFMSTDT))
87 I $P(VAFMST,"^",1)<0 D I 1
88 .F J=23,24,25 I VAFSTR[J S VAFHLZEL(J)=HLQ
89 E D
90 .;Current MST status
91 .I VAFSTR[23 S X=$P(VAFMST,"^",2),VAFHLZEL(23)=$S(X]"":X,1:HLQ)
92 .;MST status change date
93 .I VAFSTR[24 S X=$P(VAFMST,"^",3),VAFHLZEL(24)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
94 .;Site determining MST status
95 .I VAFSTR[25 S X=$P(VAFMST,"^",7) S X=$$GET1^DIQ(4,(+X)_",",99) S VAFHLZEL(25)=$S(X]"":X,1:HLQ)
96 ;Agent Orange Registration Date
97 I VAFSTR[26 S X=$P(VAF(.321),"^",7),VAFHLZEL(26)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
98 ;Agent Orange Exam Date
99 I VAFSTR[27 S X=$P(VAF(.321),"^",9),VAFHLZEL(27)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
100 ;Agent Orange Registration #
101 I VAFSTR[28 S X=$P(VAF(.321),"^",10),VAFHLZEL(28)=$S(X]"":X,1:HLQ)
102 ;Agent Orange Exposure Location
103 ;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(X]"":X,$P(VAF(.321),U,2)="Y":"U",1:HLQ)
104 I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(",K,V,O,"[(","_X_","):X,1:HLQ)
105 ;Radiation Registration Date
106 I VAFSTR[30 S X=$P(VAF(.321),"^",11),VAFHLZEL(30)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
107 ;Envir. Cont. Exam Date
108 I VAFSTR[31 S X=$P(VAF(.322),"^",15),VAFHLZEL(31)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
109 ;Envir. Cont. Registration date
110 I VAFSTR[32 S X=$P(VAF(.322),"^",14),VAFHLZEL(32)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
111 ;Monetary Ben. Verify Date
112 I VAFSTR[33 S X=$P(VAF(.3),"^",6),VAFHLZEL(33)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
113 ;User Enrollee Valid Through
114 I VAFSTR[34 S X=$P(VAF(.361),"^",7),VAFHLZEL(34)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
115 ;User Enrollee Site
116 I VAFSTR[35 S X=$P(VAF(.361),"^",8),X=$$GET1^DIQ(4,+X,99),VAFHLZEL(35)=$S(X]"":X,1:HLQ)
117 ;Combat Vet
118 I (VAFSTR[37)!(VAFSTR[38) D
119 .N CVET
120 .S CVET=$$CVEDT^DGCV(DFN)
121 .;Eligible
122 .I VAFSTR[37 D
123 ..S X=+CVET
124 ..S:X<0 X=""
125 ..S VAFHLZEL(37)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
126 .;End Date
127 .I VAFSTR[38 D
128 ..S X=+$P(CVET,"^",2)
129 ..S VAFHLZEL(38)=$S(X:$$HLDATE^HLFNC(X),1:HLQ)
130 ;Discharge Due To Disability
131 I VAFSTR[39 S X=$P(VAFPELIG,"^",13),VAFHLZEL(39)=$S(X=0:"N",X=1:"Y",1:HLQ)
132 ;SHAD Indicator
133 I VAFSTR[40 S X=$P(VAF(.321),"^",15),VAFHLZEL(40)=$S(X=0:"N",X=1:"Y",1:HLQ)
134 ;Done
135 Q
Note: See TracBrowser for help on using the repository browser.