- 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 Feb 19, 2025@00:29:24 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