VAFHLZE1 ;BPFO/JRP,TDM - Data extractor for ZEL segment ; 5/24/06 3:43pm
;;5.3;Registration;**342,497,602,672,653,1015**;Aug 13, 1993;Build 21
;
GETDATA ;Get information needed to build ZEL segment
;Input: Existance 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 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,.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)
.S:(X="")!($L(X)>1) 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)
I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(",K,V,O,"[(","_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)
;Done
Q
VAFHLZE1 ;BPFO/JRP,TDM - Data extractor for ZEL segment ; 5/24/06 3:43pm
+1 ;;5.3;Registration;**342,497,602,672,653,1015**;Aug 13, 1993;Build 21
+2 ;
GETDATA ;Get information needed to build ZEL segment
+1 ;Input: Existance 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 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,.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 IF (X="")!($LENGTH(X)>1)
SET X=HLQ
+79 IF (X'=HLQ)
SET X=$TRANSLATE(X,"NTB","234")
+80 SET VAFHLZEL(22)=X
End DoDot:1
+81 ;Call MST status API
+82 SET VAFMST=$$GETSTAT^DGMSTAPI(DFN,$GET(VAFMSTDT))
+83 IF $PIECE(VAFMST,"^",1)<0
Begin DoDot:1
+84 FOR J=23,24,25
IF VAFSTR[J
SET VAFHLZEL(J)=HLQ
End DoDot:1
IF 1
+85 IF '$TEST
Begin DoDot:1
+86 ;Current MST status
+87 IF VAFSTR[23
SET X=$PIECE(VAFMST,"^",2)
SET VAFHLZEL(23)=$SELECT(X]"":X,1:HLQ)
+88 ;MST status change date
+89 IF VAFSTR[24
SET X=$PIECE(VAFMST,"^",3)
SET VAFHLZEL(24)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+90 ;Site determining MST status
+91 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
+92 ;Agent Orange Registration Date
+93 IF VAFSTR[26
SET X=$PIECE(VAF(.321),"^",7)
SET VAFHLZEL(26)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+94 ;Agent Orange Exam Date
+95 IF VAFSTR[27
SET X=$PIECE(VAF(.321),"^",9)
SET VAFHLZEL(27)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+96 ;Agent Orange Registration #
+97 IF VAFSTR[28
SET X=$PIECE(VAF(.321),"^",10)
SET VAFHLZEL(28)=$SELECT(X]"":X,1:HLQ)
+98 ;Agent Orange Exposure Location
+99 ;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(X]"":X,$P(VAF(.321),U,2)="Y":"U",1:HLQ)
+100 IF VAFSTR[29
SET X=$PIECE(VAF(.321),"^",13)
SET VAFHLZEL(29)=$SELECT(",K,V,O,"[(","_X_","):X,1:HLQ)
+101 ;Radiation Registration Date
+102 IF VAFSTR[30
SET X=$PIECE(VAF(.321),"^",11)
SET VAFHLZEL(30)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+103 ;Envir. Cont. Exam Date
+104 IF VAFSTR[31
SET X=$PIECE(VAF(.322),"^",15)
SET VAFHLZEL(31)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+105 ;Envir. Cont. Registration date
+106 IF VAFSTR[32
SET X=$PIECE(VAF(.322),"^",14)
SET VAFHLZEL(32)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+107 ;Monetary Ben. Verify Date
+108 IF VAFSTR[33
SET X=$PIECE(VAF(.3),"^",6)
SET VAFHLZEL(33)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+109 ;User Enrollee Valid Through
+110 IF VAFSTR[34
SET X=$PIECE(VAF(.361),"^",7)
SET VAFHLZEL(34)=$SELECT(X]"":$$HLDATE^HLFNC(X),1:HLQ)
+111 ;User Enrollee Site
+112 IF VAFSTR[35
SET X=$PIECE(VAF(.361),"^",8)
SET X=$$GET1^DIQ(4,+X,99)
SET VAFHLZEL(35)=$SELECT(X]"":X,1:HLQ)
+113 ;Combat Vet
+114 IF (VAFSTR[37)!(VAFSTR[38)
Begin DoDot:1
+115 NEW CVET
+116 SET CVET=$$CVEDT^DGCV(DFN)
+117 ;Eligible
+118 IF VAFSTR[37
Begin DoDot:2
+119 SET X=+CVET
+120 IF X<0
SET X=""
+121 SET VAFHLZEL(37)=$SELECT(X]"":$$YN^VAFHLFNC(X),1:HLQ)
End DoDot:2
+122 ;End Date
+123 IF VAFSTR[38
Begin DoDot:2
+124 SET X=+$PIECE(CVET,"^",2)
+125 SET VAFHLZEL(38)=$SELECT(X:$$HLDATE^HLFNC(X),1:HLQ)
End DoDot:2
End DoDot:1
+126 ;Discharge Due To Disability
+127 IF VAFSTR[39
SET X=$PIECE(VAFPELIG,"^",13)
SET VAFHLZEL(39)=$SELECT(X=0:"N",X=1:"Y",1:HLQ)
+128 ;SHAD Indicator
+129 IF VAFSTR[40
SET X=$PIECE(VAF(.321),"^",15)
SET VAFHLZEL(40)=$SELECT(X=0:"N",X=1:"Y",1:HLQ)
+130 ;Done
+131 QUIT
