VAFHLZE1 ;BPFO/JRP,TDM,JLS,KUM - Data extractor for ZEL segment ;5/24/06 3:43pm
;;5.3;Registration;**342,497,602,672,653,909,952,1018,1090**;Aug 13,1993;Build 16
;
GETDATA ;Get information needed to build ZEL segment
;Input: Existence of the following variables is assumed
; DFN - Pointer to Patient (#2) file
; VAFPELIG - Primary Eligibility string (.36 node)
; VAFSTR - Fields to extract (padded with commas)
; VAFNODE - Eligibility Node (node from Elig. ["E"] mult)
; VAFMSTDT - Date to use when getting MST status (optional)
; VAFSETID - Value to use for Set ID (optional)
; HL7 encoding characters (HLFS, HLENC, HLQ)
;
;Output: VAFHLZEL(SeqNum) = Value
;
;Notes: VAFHLZEL is initialized (KILLed) on entry
; : If not passed, sequence 1 (Set ID) will have a value of '1'
; if getting data for the primary eligibility and '2' if getting
; data for other eligibility
; : All requested fields will be returned with the primary
; eligibility. The Set ID (seq 1), eligibility code (seq 2)
; long ID (seq 3), and short ID (seq 4) will be the only fields
; returned for all other eligibilities.
;
N IEN33,ISOTH,J,PRIME,VAF,VAFMST,X
K VAFHLZEL
;If true, primary eligibility (return all fields)
S PRIME=+VAFNODE=+VAFPELIG
;Set ID
I VAFSTR[",1," S VAFHLZEL(1)=$S($G(VAFSETID):VAFSETID,PRIME:1,1:2)
;Eligibility Code
I VAFSTR[",2," S X=$P($G(^DIC(8,+VAFNODE,0)),"^",9),VAFHLZEL(2)=$S(X]"":X,1:HLQ)
;Long ID
I VAFSTR[",3," S X=$P(VAFNODE,"^",3),VAFHLZEL(3)=$S(X]"":$$M10^HLFNC(X),1:HLQ)
;Short ID
I VAFSTR[",4," S X=$P(VAFNODE,"^",4),VAFHLZEL(4)=$S(X]"":X,1:HLQ)
;Done if not getting primary eligibility information
I 'PRIME D Q
.N Y,Z
.S Y=$L(VAFSTR,",")
.F X=1:1:Y S Z=$P(VAFSTR,",",X) I Z S:(Z>4) VAFHLZEL(Z)=HLQ
;Get needed nodes in Patient file (#2)
N VAF
F X=.3,.31,.321,.3217,.322,.362,.361 S VAF(X)=$G(^DPT(DFN,X))
;Military Disability Retirement
I VAFSTR[",5," S X=$P(VAFPELIG,"^",12),VAFHLZEL(5)=$S(X=0:"N",X=1:"Y",1:HLQ)
;Claim Number
I VAFSTR[",6," S X=$P(VAF(.31),"^",3),VAFHLZEL(6)=$S(X]"":X,1:HLQ)
;Claim Folder Loc
I VAFSTR[",7," S X=$P(VAF(.31),"^",2),VAFHLZEL(7)=$S(X]"":X,1:HLQ)
;Veteran?
I VAFSTR[",8," S X=$P($G(^DPT(DFN,"VET")),"^"),VAFHLZEL(8)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Type
I VAFSTR[",9," S X=$P($G(^DG(391,+$P($G(^DPT(DFN,"TYPE")),"^"),0)),"^"),VAFHLZEL(9)=$S(X]"":X,1:HLQ)
;Elig Status
I VAFSTR[10 S X=$P(VAF(.361),"^",1),VAFHLZEL(10)=$S(X]"":X,1:HLQ)
;Elig Status Date
I VAFSTR[11 S X=$P(VAF(.361),"^",2),VAFHLZEL(11)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;Elig Interim Response
I VAFSTR[12 S X=$P(VAF(.361),"^",4),VAFHLZEL(12)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;Elig Verif. Method
I VAFSTR[13 S X=$P(VAF(.361),"^",5),VAFHLZEL(13)=$S(X]"":X,1:HLQ)
;Rec A&A Benefits?
I VAFSTR[14 S X=$P(VAF(.362),"^",12),VAFHLZEL(14)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Rec Housebound Benefits?
I VAFSTR[15 S X=$P(VAF(.362),"^",13),VAFHLZEL(15)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Rec VA Pension?
I VAFSTR[16 S X=$P(VAF(.362),"^",14),VAFHLZEL(16)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Rec VA Disability?
I VAFSTR[17 S X=$P(VAF(.3),"^",11),VAFHLZEL(17)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Agent Orange Expos. Indicated?
I VAFSTR[18 S X=$P(VAF(.321),"^",2),VAFHLZEL(18)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Radiation Expos. Indicated?
I VAFSTR[19 S X=$P(VAF(.321),"^",3),VAFHLZEL(19)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Environmental Contaminants?
I VAFSTR[20 S X=$P(VAF(.322),"^",13),VAFHLZEL(20)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
;Total Annual VA Check Amount
I VAFSTR[21 S X=$P(VAF(.362),"^",20),VAFHLZEL(21)=$S(X]"":X,1:HLQ)
;Radiation Exposure Method
I (VAFSTR[22) D
.S X=$P(VAF(.321),"^",12)
.;DG*5.3*1090 - Accommodate two digit values
.;S:(X="")!($L(X)>1) X=HLQ
.S:(X="")!($L(X)>2) X=HLQ
.S:(X'=HLQ) X=$TR(X,"NTB","234")
.S VAFHLZEL(22)=X
;Call MST status API
S VAFMST=$$GETSTAT^DGMSTAPI(DFN,$G(VAFMSTDT))
I $P(VAFMST,"^",1)<0 D I 1
.F J=23,24,25 I VAFSTR[J S VAFHLZEL(J)=HLQ
E D
.;Current MST status
.I VAFSTR[23 S X=$P(VAFMST,"^",2),VAFHLZEL(23)=$S(X]"":X,1:HLQ)
.;MST status change date
.I VAFSTR[24 S X=$P(VAFMST,"^",3),VAFHLZEL(24)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
.;Site determining MST status
.I VAFSTR[25 S X=$P(VAFMST,"^",7) S X=$$GET1^DIQ(4,(+X)_",",99) S VAFHLZEL(25)=$S(X]"":X,1:HLQ)
;Agent Orange Registration Date
I VAFSTR[26 S X=$P(VAF(.321),"^",7),VAFHLZEL(26)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;Agent Orange Exam Date
I VAFSTR[27 S X=$P(VAF(.321),"^",9),VAFHLZEL(27)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;Agent Orange Registration #
I VAFSTR[28 S X=$P(VAF(.321),"^",10),VAFHLZEL(28)=$S(X]"":X,1:HLQ)
;Agent Orange Exposure Location
;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(X]"":X,$P(VAF(.321),U,2)="Y":"U",1:HLQ)
;DG*5.3*1018 - Add Blue Water Navy value
;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(",K,V,O,"[(","_X_","):X,1:HLQ)
;DG*5.3*1090 - Add T, L, C, G, J
I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(",K,V,O,B,T,L,C,G,J,"[(","_X_","):X,1:HLQ)
;Radiation Registration Date
I VAFSTR[30 S X=$P(VAF(.321),"^",11),VAFHLZEL(30)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;Envir. Cont. Exam Date
I VAFSTR[31 S X=$P(VAF(.322),"^",15),VAFHLZEL(31)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;Envir. Cont. Registration date
I VAFSTR[32 S X=$P(VAF(.322),"^",14),VAFHLZEL(32)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;Monetary Ben. Verify Date
I VAFSTR[33 S X=$P(VAF(.3),"^",6),VAFHLZEL(33)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;User Enrollee Valid Through
I VAFSTR[34 S X=$P(VAF(.361),"^",7),VAFHLZEL(34)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
;User Enrollee Site
I VAFSTR[35 S X=$P(VAF(.361),"^",8),X=$$GET1^DIQ(4,+X,99),VAFHLZEL(35)=$S(X]"":X,1:HLQ)
;Combat Vet
I (VAFSTR[37)!(VAFSTR[38) D
.N CVET
.S CVET=$$CVEDT^DGCV(DFN)
.;Eligible
.I VAFSTR[37 D
..S X=+CVET
..S:X<0 X=""
..S VAFHLZEL(37)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
.;End Date
.I VAFSTR[38 D
..S X=+$P(CVET,"^",2)
..S VAFHLZEL(38)=$S(X:$$HLDATE^HLFNC(X),1:HLQ)
;Discharge Due To Disability
I VAFSTR[39 S X=$P(VAFPELIG,"^",13),VAFHLZEL(39)=$S(X=0:"N",X=1:"Y",1:HLQ)
;SHAD Indicator
I VAFSTR[40 S X=$P(VAF(.321),"^",15),VAFHLZEL(40)=$S(X=0:"N",X=1:"Y",1:HLQ)
;CAMP LEJEUNE ELIGIBILITY INDICATOR DG*5.3*909
S X=$P(VAF(.3217),"^",1),VAFHLZEL(41)=$S(X="Y":1,X="N":0,1:HLQ)
;CAMP LEJEUNE ELIGIBILITY DATE REGISTERED
I VAFSTR[42 S X=$P(VAF(.3217),"^",2),VAFHLZEL(42)=$S(X]"":$P($$HLDATE^HLFNC(X,"DT"),"^",1),1:HLQ)
;CAMP LEJEUNE ELIGIBILITY CHANGE SITE
I VAFSTR[43 S X=$P(VAF(.3217),"^",3),VAFHLZEL(43)=$S(X]"":X,1:HLQ)
;CAMP LEJEUNE ELIGIBILITY SOURCE OF CHANGE
I VAFSTR[44 S X=$P(VAF(.3217),"^",4),VAFHLZEL(44)=$S(X]"":X,1:HLQ)
S ISOTH="",IEN33=+$O(^DGOTH(33,"B",DFN,"")) I IEN33 S ISOTH=$$GET1^DIQ(33,IEN33_",",.02,"I")
;OTH Eligibility Indicator
I VAFSTR[45 S VAFHLZEL(45)=$S(IEN33:ISOTH,1:"")
;OTH Eligibility Factor Code
I VAFSTR[46 S VAFHLZEL(46)="" S:IEN33 X=$$GET1^DIQ(2,DFN_",",.5501,"I"),VAFHLZEL(46)=$S(X="OTH-90":1,X="OTH-EXT":2,1:"")
;OTH Eligibility Update Date
I VAFSTR[47 S VAFHLZEL(47)=$S(IEN33:$$HLDATE^HLFNC($$GETTIMST^DGOTHEL(DFN)),1:"")
;Done
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZE1 7274 printed Apr 09, 2024@21:55:57 Page 2
VAFHLZE1 ;BPFO/JRP,TDM,JLS,KUM - Data extractor for ZEL segment ;5/24/06 3:43pm
+1 ;;5.3;Registration;**342,497,602,672,653,909,952,1018,1090**;Aug 13,1993;Build 16
+2 ;
GETDATA ;Get information needed to build ZEL segment
+1 ;Input: Existence of the following variables is assumed
+2 ; DFN - Pointer to Patient (#2) file
+3 ; VAFPELIG - Primary Eligibility string (.36 node)
+4 ; VAFSTR - Fields to extract (padded with commas)
+5 ; VAFNODE - Eligibility Node (node from Elig. ["E"] mult)
+6 ; VAFMSTDT - Date to use when getting MST status (optional)
+7 ; VAFSETID - Value to use for Set ID (optional)
+8 ; HL7 encoding characters (HLFS, HLENC, HLQ)
+9 ;
+10 ;Output: VAFHLZEL(SeqNum) = Value
+11 ;
+12 ;Notes: VAFHLZEL is initialized (KILLed) on entry
+13 ; : If not passed, sequence 1 (Set ID) will have a value of '1'
+14 ; if getting data for the primary eligibility and '2' if getting
+15 ; data for other eligibility
+16 ; : All requested fields will be returned with the primary
+17 ; eligibility. The Set ID (seq 1), eligibility code (seq 2)
+18 ; long ID (seq 3), and short ID (seq 4) will be the only fields
+19 ; returned for all other eligibilities.
+20 ;
+21 NEW IEN33,ISOTH,J,PRIME,VAF,VAFMST,X
+22 KILL VAFHLZEL
+23 ;If true, primary eligibility (return all fields)
+24 SET PRIME=+VAFNODE=+VAFPELIG
+25 ;Set ID
+26 IF VAFSTR[",1,"
SET VAFHLZEL(1)=$SELECT($GET(VAFSETID):VAFSETID,PRIME:1,1:2)
+27 ;Eligibility Code
+28 IF VAFSTR[",2,"
SET X=$PIECE($GET(^DIC(8,+VAFNODE,0)),"^",9)
SET VAFHLZEL(2)=$SELECT(X]"":X,1:HLQ)
+29 ;Long ID
+30 IF VAFSTR[",3,"
SET X=$PIECE(VAFNODE,"^",3)
SET VAFHLZEL(3)=$SELECT(X]"":$$M10^HLFNC(X),1:HLQ)
+31 ;Short ID
+32 IF VAFSTR[",4,"
SET X=$PIECE(VAFNODE,"^",4)
SET VAFHLZEL(4)=$SELECT(X]"":X,1:HLQ)
+33 ;Done if not getting primary eligibility information
+34 IF 'PRIME
Begin DoDot:1
+35 NEW Y,Z
+36 SET Y=$LENGTH(VAFSTR,",")
+37 FOR X=1:1:Y
SET Z=$PIECE(VAFSTR,",",X)
IF Z
if (Z>4)
SET VAFHLZEL(Z)=HLQ
End DoDot:1
QUIT
+38 ;Get needed nodes in Patient file (#2)
+39 NEW VAF
+40 FOR X=.3,.31,.321,.3217,.322,.362,.361
SET VAF(X)=$GET(^DPT(DFN,X))
+41 ;Military Disability Retirement
+42 IF VAFSTR[",5,"
SET X=$PIECE(VAFPELIG,"^",12)
SET VAFHLZEL(5)=$SELECT(X=0:"N",X=1:"Y",1:HLQ)
+43 ;Claim Number
+44 IF VAFSTR[",6,"
SET X=$PIECE(VAF(.31),"^",3)
SET VAFHLZEL(6)=$SELECT(X]"":X,1:HLQ)
+45 ;Claim Folder Loc
+46 IF VAFSTR[",7,"
SET X=$PIECE(VAF(.31),"^",2)
SET VAFHLZEL(7)=$SELECT(X]"":X,1:HLQ)
+47 ;Veteran?
+48 IF VAFSTR[",8,"
SET X=$PIECE($GET(^DPT(DFN,"VET")),"^")
SET VAFHLZEL(8)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+49 ;Type
+50 IF VAFSTR[",9,"
SET X=$PIECE($GET(^DG(391,+$PIECE($GET(^DPT(DFN,"TYPE")),"^"),0)),"^")
SET VAFHLZEL(9)=$SELECT(X]"":X,1:HLQ)
+51 ;Elig Status
+52 IF VAFSTR[10
SET X=$PIECE(VAF(.361),"^",1)
SET VAFHLZEL(10)=$SELECT(X]"":X,1:HLQ)
+53 ;Elig Status Date
+54 IF VAFSTR[11
SET X=$PIECE(VAF(.361),"^",2)
SET VAFHLZEL(11)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+55 ;Elig Interim Response
+56 IF VAFSTR[12
SET X=$PIECE(VAF(.361),"^",4)
SET VAFHLZEL(12)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+57 ;Elig Verif. Method
+58 IF VAFSTR[13
SET X=$PIECE(VAF(.361),"^",5)
SET VAFHLZEL(13)=$SELECT(X]"":X,1:HLQ)
+59 ;Rec A&A Benefits?
+60 IF VAFSTR[14
SET X=$PIECE(VAF(.362),"^",12)
SET VAFHLZEL(14)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+61 ;Rec Housebound Benefits?
+62 IF VAFSTR[15
SET X=$PIECE(VAF(.362),"^",13)
SET VAFHLZEL(15)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+63 ;Rec VA Pension?
+64 IF VAFSTR[16
SET X=$PIECE(VAF(.362),"^",14)
SET VAFHLZEL(16)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+65 ;Rec VA Disability?
+66 IF VAFSTR[17
SET X=$PIECE(VAF(.3),"^",11)
SET VAFHLZEL(17)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+67 ;Agent Orange Expos. Indicated?
+68 IF VAFSTR[18
SET X=$PIECE(VAF(.321),"^",2)
SET VAFHLZEL(18)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+69 ;Radiation Expos. Indicated?
+70 IF VAFSTR[19
SET X=$PIECE(VAF(.321),"^",3)
SET VAFHLZEL(19)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+71 ;Environmental Contaminants?
+72 IF VAFSTR[20
SET X=$PIECE(VAF(.322),"^",13)
SET VAFHLZEL(20)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
+73 ;Total Annual VA Check Amount
+74 IF VAFSTR[21
SET X=$PIECE(VAF(.362),"^",20)
SET VAFHLZEL(21)=$SELECT(X]"":X,1:HLQ)
+75 ;Radiation Exposure Method
+76 IF (VAFSTR[22)
Begin DoDot:1
+77 SET X=$PIECE(VAF(.321),"^",12)
+78 ;DG*5.3*1090 - Accommodate two digit values
+79 ;S:(X="")!($L(X)>1) X=HLQ
+80 if (X="")!($LENGTH(X)>2)
SET X=HLQ
+81 if (X'=HLQ)
SET X=$TRANSLATE(X,"NTB","234")
+82 SET VAFHLZEL(22)=X
End DoDot:1
+83 ;Call MST status API
+84 SET VAFMST=$$GETSTAT^DGMSTAPI(DFN,$GET(VAFMSTDT))
+85 IF $PIECE(VAFMST,"^",1)<0
Begin DoDot:1
+86 FOR J=23,24,25
IF VAFSTR[J
SET VAFHLZEL(J)=HLQ
End DoDot:1
IF 1
+87 IF '$TEST
Begin DoDot:1
+88 ;Current MST status
+89 IF VAFSTR[23
SET X=$PIECE(VAFMST,"^",2)
SET VAFHLZEL(23)=$SELECT(X]"":X,1:HLQ)
+90 ;MST status change date
+91 IF VAFSTR[24
SET X=$PIECE(VAFMST,"^",3)
SET VAFHLZEL(24)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+92 ;Site determining MST status
+93 IF VAFSTR[25
SET X=$PIECE(VAFMST,"^",7)
SET X=$$GET1^DIQ(4,(+X)_",",99)
SET VAFHLZEL(25)=$SELECT(X]"":X,1:HLQ)
End DoDot:1
+94 ;Agent Orange Registration Date
+95 IF VAFSTR[26
SET X=$PIECE(VAF(.321),"^",7)
SET VAFHLZEL(26)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+96 ;Agent Orange Exam Date
+97 IF VAFSTR[27
SET X=$PIECE(VAF(.321),"^",9)
SET VAFHLZEL(27)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+98 ;Agent Orange Registration #
+99 IF VAFSTR[28
SET X=$PIECE(VAF(.321),"^",10)
SET VAFHLZEL(28)=$SELECT(X]"":X,1:HLQ)
+100 ;Agent Orange Exposure Location
+101 ;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(X]"":X,$P(VAF(.321),U,2)="Y":"U",1:HLQ)
+102 ;DG*5.3*1018 - Add Blue Water Navy value
+103 ;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(",K,V,O,"[(","_X_","):X,1:HLQ)
+104 ;DG*5.3*1090 - Add T, L, C, G, J
+105 IF VAFSTR[29
SET X=$PIECE(VAF(.321),"^",13)
SET VAFHLZEL(29)=$SELECT(",K,V,O,B,T,L,C,G,J,"[(","_X_","):X,1:HLQ)
+106 ;Radiation Registration Date
+107 IF VAFSTR[30
SET X=$PIECE(VAF(.321),"^",11)
SET VAFHLZEL(30)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+108 ;Envir. Cont. Exam Date
+109 IF VAFSTR[31
SET X=$PIECE(VAF(.322),"^",15)
SET VAFHLZEL(31)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+110 ;Envir. Cont. Registration date
+111 IF VAFSTR[32
SET X=$PIECE(VAF(.322),"^",14)
SET VAFHLZEL(32)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+112 ;Monetary Ben. Verify Date
+113 IF VAFSTR[33
SET X=$PIECE(VAF(.3),"^",6)
SET VAFHLZEL(33)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+114 ;User Enrollee Valid Through
+115 IF VAFSTR[34
SET X=$PIECE(VAF(.361),"^",7)
SET VAFHLZEL(34)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+116 ;User Enrollee Site
+117 IF VAFSTR[35
SET X=$PIECE(VAF(.361),"^",8)
SET X=$$GET1^DIQ(4,+X,99)
SET VAFHLZEL(35)=$SELECT(X]"":X,1:HLQ)
+118 ;Combat Vet
+119 IF (VAFSTR[37)!(VAFSTR[38)
Begin DoDot:1
+120 NEW CVET
+121 SET CVET=$$CVEDT^DGCV(DFN)
+122 ;Eligible
+123 IF VAFSTR[37
Begin DoDot:2
+124 SET X=+CVET
+125 if X<0
SET X=""
+126 SET VAFHLZEL(37)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
End DoDot:2
+127 ;End Date
+128 IF VAFSTR[38
Begin DoDot:2
+129 SET X=+$PIECE(CVET,"^",2)
+130 SET VAFHLZEL(38)=$SELECT(X:$$HLDATE^HLFNC(X),1:HLQ)
End DoDot:2
End DoDot:1
+131 ;Discharge Due To Disability
+132 IF VAFSTR[39
SET X=$PIECE(VAFPELIG,"^",13)
SET VAFHLZEL(39)=$SELECT(X=0:"N",X=1:"Y",1:HLQ)
+133 ;SHAD Indicator
+134 IF VAFSTR[40
SET X=$PIECE(VAF(.321),"^",15)
SET VAFHLZEL(40)=$SELECT(X=0:"N",X=1:"Y",1:HLQ)
+135 ;CAMP LEJEUNE ELIGIBILITY INDICATOR DG*5.3*909
+136 SET X=$PIECE(VAF(.3217),"^",1)
SET VAFHLZEL(41)=$SELECT(X="Y":1,X="N":0,1:HLQ)
+137 ;CAMP LEJEUNE ELIGIBILITY DATE REGISTERED
+138 IF VAFSTR[42
SET X=$PIECE(VAF(.3217),"^",2)
SET VAFHLZEL(42)=$SELECT(X]"":$PIECE($$HLDATE^HLFNC(X,"DT"),"^",1),1:HLQ)
+139 ;CAMP LEJEUNE ELIGIBILITY CHANGE SITE
+140 IF VAFSTR[43
SET X=$PIECE(VAF(.3217),"^",3)
SET VAFHLZEL(43)=$SELECT(X]"":X,1:HLQ)
+141 ;CAMP LEJEUNE ELIGIBILITY SOURCE OF CHANGE
+142 IF VAFSTR[44
SET X=$PIECE(VAF(.3217),"^",4)
SET VAFHLZEL(44)=$SELECT(X]"":X,1:HLQ)
+143 SET ISOTH=""
SET IEN33=+$ORDER(^DGOTH(33,"B",DFN,""))
IF IEN33
SET ISOTH=$$GET1^DIQ(33,IEN33_",",.02,"I")
+144 ;OTH Eligibility Indicator
+145 IF VAFSTR[45
SET VAFHLZEL(45)=$SELECT(IEN33:ISOTH,1:"")
+146 ;OTH Eligibility Factor Code
+147 IF VAFSTR[46
SET VAFHLZEL(46)=""
if IEN33
SET X=$$GET1^DIQ(2,DFN_",",.5501,"I")
SET VAFHLZEL(46)=$SELECT(X="OTH-90":1,X="OTH-EXT":2,1:"")
+148 ;OTH Eligibility Update Date
+149 IF VAFSTR[47
SET VAFHLZEL(47)=$SELECT(IEN33:$$HLDATE^HLFNC($$GETTIMST^DGOTHEL(DFN)),1:"")
+150 ;Done
+151 QUIT
