Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHLZE1

VAFHLZE1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. GETDATA ;Get information needed to build ZEL segment
  1. ;Input: Existence of the following variables is assumed
  1. ; DFN - Pointer to Patient (#2) file
  1. ; VAFPELIG - Primary Eligibility string (.36 node)
  1. ; VAFSTR - Fields to extract (padded with commas)
  1. ; VAFNODE - Eligibility Node (node from Elig. ["E"] mult)
  1. ; VAFMSTDT - Date to use when getting MST status (optional)
  1. ; VAFSETID - Value to use for Set ID (optional)
  1. ; HL7 encoding characters (HLFS, HLENC, HLQ)
  1. ;
  1. ;Output: VAFHLZEL(SeqNum) = Value
  1. ;
  1. ;Notes: VAFHLZEL is initialized (KILLed) on entry
  1. ; : If not passed, sequence 1 (Set ID) will have a value of '1'
  1. ; if getting data for the primary eligibility and '2' if getting
  1. ; data for other eligibility
  1. ; : All requested fields will be returned with the primary
  1. ; eligibility. The Set ID (seq 1), eligibility code (seq 2)
  1. ; long ID (seq 3), and short ID (seq 4) will be the only fields
  1. ; returned for all other eligibilities.
  1. ;
  1. N IEN33,ISOTH,J,PRIME,VAF,VAFMST,X
  1. K VAFHLZEL
  1. ;If true, primary eligibility (return all fields)
  1. S PRIME=+VAFNODE=+VAFPELIG
  1. ;Set ID
  1. I VAFSTR[",1," S VAFHLZEL(1)=$S($G(VAFSETID):VAFSETID,PRIME:1,1:2)
  1. ;Eligibility Code
  1. I VAFSTR[",2," S X=$P($G(^DIC(8,+VAFNODE,0)),"^",9),VAFHLZEL(2)=$S(X]"":X,1:HLQ)
  1. ;Long ID
  1. I VAFSTR[",3," S X=$P(VAFNODE,"^",3),VAFHLZEL(3)=$S(X]"":$$M10^HLFNC(X),1:HLQ)
  1. ;Short ID
  1. I VAFSTR[",4," S X=$P(VAFNODE,"^",4),VAFHLZEL(4)=$S(X]"":X,1:HLQ)
  1. ;Done if not getting primary eligibility information
  1. I 'PRIME D Q
  1. .N Y,Z
  1. .S Y=$L(VAFSTR,",")
  1. .F X=1:1:Y S Z=$P(VAFSTR,",",X) I Z S:(Z>4) VAFHLZEL(Z)=HLQ
  1. ;Get needed nodes in Patient file (#2)
  1. N VAF
  1. F X=.3,.31,.321,.3217,.322,.362,.361 S VAF(X)=$G(^DPT(DFN,X))
  1. ;Military Disability Retirement
  1. I VAFSTR[",5," S X=$P(VAFPELIG,"^",12),VAFHLZEL(5)=$S(X=0:"N",X=1:"Y",1:HLQ)
  1. ;Claim Number
  1. I VAFSTR[",6," S X=$P(VAF(.31),"^",3),VAFHLZEL(6)=$S(X]"":X,1:HLQ)
  1. ;Claim Folder Loc
  1. I VAFSTR[",7," S X=$P(VAF(.31),"^",2),VAFHLZEL(7)=$S(X]"":X,1:HLQ)
  1. ;Veteran?
  1. I VAFSTR[",8," S X=$P($G(^DPT(DFN,"VET")),"^"),VAFHLZEL(8)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Type
  1. I VAFSTR[",9," S X=$P($G(^DG(391,+$P($G(^DPT(DFN,"TYPE")),"^"),0)),"^"),VAFHLZEL(9)=$S(X]"":X,1:HLQ)
  1. ;Elig Status
  1. I VAFSTR[10 S X=$P(VAF(.361),"^",1),VAFHLZEL(10)=$S(X]"":X,1:HLQ)
  1. ;Elig Status Date
  1. I VAFSTR[11 S X=$P(VAF(.361),"^",2),VAFHLZEL(11)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Elig Interim Response
  1. I VAFSTR[12 S X=$P(VAF(.361),"^",4),VAFHLZEL(12)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Elig Verif. Method
  1. I VAFSTR[13 S X=$P(VAF(.361),"^",5),VAFHLZEL(13)=$S(X]"":X,1:HLQ)
  1. ;Rec A&A Benefits?
  1. I VAFSTR[14 S X=$P(VAF(.362),"^",12),VAFHLZEL(14)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Rec Housebound Benefits?
  1. I VAFSTR[15 S X=$P(VAF(.362),"^",13),VAFHLZEL(15)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Rec VA Pension?
  1. I VAFSTR[16 S X=$P(VAF(.362),"^",14),VAFHLZEL(16)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Rec VA Disability?
  1. I VAFSTR[17 S X=$P(VAF(.3),"^",11),VAFHLZEL(17)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Agent Orange Expos. Indicated?
  1. I VAFSTR[18 S X=$P(VAF(.321),"^",2),VAFHLZEL(18)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Radiation Expos. Indicated?
  1. I VAFSTR[19 S X=$P(VAF(.321),"^",3),VAFHLZEL(19)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Environmental Contaminants?
  1. I VAFSTR[20 S X=$P(VAF(.322),"^",13),VAFHLZEL(20)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. ;Total Annual VA Check Amount
  1. I VAFSTR[21 S X=$P(VAF(.362),"^",20),VAFHLZEL(21)=$S(X]"":X,1:HLQ)
  1. ;Radiation Exposure Method
  1. I (VAFSTR[22) D
  1. .S X=$P(VAF(.321),"^",12)
  1. .;DG*5.3*1090 - Accommodate two digit values
  1. .;S:(X="")!($L(X)>1) X=HLQ
  1. .S:(X="")!($L(X)>2) X=HLQ
  1. .S:(X'=HLQ) X=$TR(X,"NTB","234")
  1. .S VAFHLZEL(22)=X
  1. ;Call MST status API
  1. S VAFMST=$$GETSTAT^DGMSTAPI(DFN,$G(VAFMSTDT))
  1. I $P(VAFMST,"^",1)<0 D I 1
  1. .F J=23,24,25 I VAFSTR[J S VAFHLZEL(J)=HLQ
  1. E D
  1. .;Current MST status
  1. .I VAFSTR[23 S X=$P(VAFMST,"^",2),VAFHLZEL(23)=$S(X]"":X,1:HLQ)
  1. .;MST status change date
  1. .I VAFSTR[24 S X=$P(VAFMST,"^",3),VAFHLZEL(24)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. .;Site determining MST status
  1. .I VAFSTR[25 S X=$P(VAFMST,"^",7) S X=$$GET1^DIQ(4,(+X)_",",99) S VAFHLZEL(25)=$S(X]"":X,1:HLQ)
  1. ;Agent Orange Registration Date
  1. I VAFSTR[26 S X=$P(VAF(.321),"^",7),VAFHLZEL(26)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Agent Orange Exam Date
  1. I VAFSTR[27 S X=$P(VAF(.321),"^",9),VAFHLZEL(27)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Agent Orange Registration #
  1. I VAFSTR[28 S X=$P(VAF(.321),"^",10),VAFHLZEL(28)=$S(X]"":X,1:HLQ)
  1. ;Agent Orange Exposure Location
  1. ;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(X]"":X,$P(VAF(.321),U,2)="Y":"U",1:HLQ)
  1. ;DG*5.3*1018 - Add Blue Water Navy value
  1. ;I VAFSTR[29 S X=$P(VAF(.321),"^",13),VAFHLZEL(29)=$S(",K,V,O,"[(","_X_","):X,1:HLQ)
  1. ;DG*5.3*1090 - Add T, L, C, G, J
  1. 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)
  1. ;Radiation Registration Date
  1. I VAFSTR[30 S X=$P(VAF(.321),"^",11),VAFHLZEL(30)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Envir. Cont. Exam Date
  1. I VAFSTR[31 S X=$P(VAF(.322),"^",15),VAFHLZEL(31)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Envir. Cont. Registration date
  1. I VAFSTR[32 S X=$P(VAF(.322),"^",14),VAFHLZEL(32)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Monetary Ben. Verify Date
  1. I VAFSTR[33 S X=$P(VAF(.3),"^",6),VAFHLZEL(33)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;User Enrollee Valid Through
  1. I VAFSTR[34 S X=$P(VAF(.361),"^",7),VAFHLZEL(34)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ)
  1. ;User Enrollee Site
  1. I VAFSTR[35 S X=$P(VAF(.361),"^",8),X=$$GET1^DIQ(4,+X,99),VAFHLZEL(35)=$S(X]"":X,1:HLQ)
  1. ;Combat Vet
  1. I (VAFSTR[37)!(VAFSTR[38) D
  1. .N CVET
  1. .S CVET=$$CVEDT^DGCV(DFN)
  1. .;Eligible
  1. .I VAFSTR[37 D
  1. ..S X=+CVET
  1. ..S:X<0 X=""
  1. ..S VAFHLZEL(37)=$S(X]"":$$YN^VAFHLFNC(X),1:HLQ)
  1. .;End Date
  1. .I VAFSTR[38 D
  1. ..S X=+$P(CVET,"^",2)
  1. ..S VAFHLZEL(38)=$S(X:$$HLDATE^HLFNC(X),1:HLQ)
  1. ;Discharge Due To Disability
  1. I VAFSTR[39 S X=$P(VAFPELIG,"^",13),VAFHLZEL(39)=$S(X=0:"N",X=1:"Y",1:HLQ)
  1. ;SHAD Indicator
  1. I VAFSTR[40 S X=$P(VAF(.321),"^",15),VAFHLZEL(40)=$S(X=0:"N",X=1:"Y",1:HLQ)
  1. ;CAMP LEJEUNE ELIGIBILITY INDICATOR DG*5.3*909
  1. S X=$P(VAF(.3217),"^",1),VAFHLZEL(41)=$S(X="Y":1,X="N":0,1:HLQ)
  1. ;CAMP LEJEUNE ELIGIBILITY DATE REGISTERED
  1. I VAFSTR[42 S X=$P(VAF(.3217),"^",2),VAFHLZEL(42)=$S(X]"":$P($$HLDATE^HLFNC(X,"DT"),"^",1),1:HLQ)
  1. ;CAMP LEJEUNE ELIGIBILITY CHANGE SITE
  1. I VAFSTR[43 S X=$P(VAF(.3217),"^",3),VAFHLZEL(43)=$S(X]"":X,1:HLQ)
  1. ;CAMP LEJEUNE ELIGIBILITY SOURCE OF CHANGE
  1. I VAFSTR[44 S X=$P(VAF(.3217),"^",4),VAFHLZEL(44)=$S(X]"":X,1:HLQ)
  1. S ISOTH="",IEN33=+$O(^DGOTH(33,"B",DFN,"")) I IEN33 S ISOTH=$$GET1^DIQ(33,IEN33_",",.02,"I")
  1. ;OTH Eligibility Indicator
  1. I VAFSTR[45 S VAFHLZEL(45)=$S(IEN33:ISOTH,1:"")
  1. ;OTH Eligibility Factor Code
  1. 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:"")
  1. ;OTH Eligibility Update Date
  1. I VAFSTR[47 S VAFHLZEL(47)=$S(IEN33:$$HLDATE^HLFNC($$GETTIMST^DGOTHEL(DFN)),1:"")
  1. ;Done
  1. Q