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

DGENCLEA.m

Go to the documentation of this file.
  1. DGENCLEA ;ALB/JLS - Camp Lejeune Eligibility API - Retrieve Eligibility ;11/28/14 4:25pm
  1. ;;5.3;Registration;**909**;Aug 13,1993;Build 32
  1. ;
  1. ; Business Rules to determine Camp Lejeune Eligibility:
  1. ;. Person is a Veteran AND
  1. ; . Either ("Rule 1")
  1. ; . Has one Military Service Episode (DGMSE) between, and inclusive of, Aug 1, 1953 and Dec 31, 1987 and
  1. ; . The identified DGMSE has a character of discharge other than
  1. ; . Dishonorable
  1. ; . Other Than Honorable
  1. ; . Undesirable
  1. ; . Bad Conduct
  1. ; . Dishonorable-VA
  1. ;AND
  1. ; . The identified DGMSE is at least 30 days in duration
  1. ; . OR ("Rule 2"; perform this check only if "Rule 1" was not met)
  1. ; . Has more than one Military Service Episodes (DGMSEs) between, and inclusive of, Aug 1, 1953 and Dec 31, 1987 AND
  1. ; . All of the identified DGMSEs have a character of discharge other than
  1. ; . Dishonorable
  1. ; . Other Than Honorable
  1. ; . Undesirable
  1. ; . Bad Conduct
  1. ; . Dishonorable-VA
  1. ;AND
  1. ; . The sum of two or more of the identified DGMSEs add up to at least 30 days in duration (meaning that it does not have to be consecutive days)
  1. ;
  1. ; Inputs: DFN
  1. ; Outputs: CLE returns 1 if patient is camp lejeune eligible, returns 0 if not camp lejeune eligible
  1. ; 0 - CLE "Not Eligible"
  1. ; 1 - CLE "Eligible"
  1. ;
  1. CLE(DFN) ;
  1. K DGMSE
  1. ; Is patient a veteran VET1 Is the patient an eligible veteran VET
  1. I '$$VET^DGENPTA(DFN) Q 0
  1. ; If primary eligibility code exists it must be a Veteran Type Eligibility Code from File 8
  1. N DGPRIEL
  1. S DGPRIEL=$P($G(^DPT(DFN,.36)),U,1)
  1. I DGPRIEL]"",$P($G(^DIC(8,DGPRIEL,0)),U,5)="N" Q 0
  1. ; Get DGMSE data from DGMSE sub-file #2.3216 first, if that does not exist get DGMSE data from .32 node
  1. N DGMSE
  1. I $D(^DPT(DFN,.3216)) D GETMSE^DGMSEUTL(DFN,.DGMSE)
  1. I $G(DGMSE)="" S DGMSE=$G(^DPT(DFN,.32))
  1. I '$D(DGMSE) Q 0
  1. ; Loop through DGMSE to find at least 1 qualifying DGMSE (CLE=1)
  1. N DGENTDT,DGEXITDT,DGTYPE,DGLOOP,DGCLE,DGCLSRDT,X1,X2
  1. S (DGCLE,DGCLSRDT)=0
  1. S DGLOOP="" F S DGLOOP=$O(DGMSE(DGLOOP)) Q:(DGLOOP="")!(DGCLE=1) D
  1. . S (DGENTDT,DGEXITDT,DGTYPE,X1,X2)=""
  1. . S DGENTDT=$$FMTH^XLFDT($P(DGMSE(DGLOOP),"^",1),1),DGEXITDT=$$FMTH^XLFDT($P(DGMSE(DGLOOP),"^",2),1),DGTYPE=$P(DGMSE(DGLOOP),"^",6)
  1. . ;automatically quit out of this DGMSE if Discharge is 2,4,5,6,8 or null
  1. . ;File #25 (Dishonorable,Other Than Dishonorable,Undesirable,Bad Conduct,Dishonorable-VA
  1. . Q:(DGTYPE=2)!(DGTYPE=4)!(DGTYPE=5)!(DGTYPE=6)!(DGTYPE=8)!(DGTYPE="")
  1. . ;automatically quit out if DGMSE is NOT within date range
  1. . ;08011953 and 12311987
  1. . ;$H 41120(subtracted +1 to be 'inclusive') and 53690(added +1 to be 'inclusive')
  1. . ;FM 2530801 and 2871231
  1. . Q:(DGENTDT>53690)!(DGEXITDT<41120) ;if either date is out of CLE date range do not continue (ineligible)
  1. . I DGENTDT<41120 S DGENTDT=41120 ;only include Entry Dates starting from CLE date range
  1. . I DGEXITDT>53690 S DGEXITDT=53690 ;only include Exit Dates ending at CLE date range
  1. . S X1=$$HTFM^XLFDT($G(DGEXITDT)),X2=$$HTFM^XLFDT($G(DGENTDT)) D ^%DTC S DGCLSRDT=DGCLSRDT+(X+1)
  1. . ;automatically quit out if DGMSE is NOT greater than 30 days
  1. . Q:DGCLSRDT<30
  1. . S DGCLE=1
  1. Q DGCLE
  1. ;
  1. ADDEDTCL(DFN) ; DG*5.3*909 Enter/Edit Camp Lejeune Indicator
  1. ;
  1. AECL2 N DGCLIND,DGCLOLD,DGSITE,X,Y
  1. K DIR S DIR(0)="YO"
  1. S DIR("A")="CAMP LEJEUNE WATER CONTAMINANT EXPOSURE INDICATED"
  1. S DGCLOLD=$P($G(^DPT(DFN,.3217)),U,1)
  1. S DIR("B")=$S(DGCLOLD="Y":"YES",DGCLOLD="N":"NO",1:"")
  1. K:DIR("B")="" DIR("B")
  1. S DIR("?",1)="Enter "_$C(34)_"Y"_$C(34)_" if veteran claims need "
  1. S DIR("?",1)=DIR("?",1)_"for care of conditions related to exposure of"
  1. S DIR("?",2)=$C(34)_"Water Contamination at Camp Lejeune"_$C(34)
  1. S DIR("?",2)=DIR("?",2)_". Enter "_$C(34)_"N"_$C(34)_" if veteran "
  1. S DIR("?",2)=DIR("?",2)_"was not assigned to"
  1. S DIR("?",3)="Camp Lejeune between August 1, 1953 and December 31, "
  1. S DIR("?",3)=DIR("?",3)_"1987 or does not claim need"
  1. S DIR("?",4)="for care of conditions related to exposure of "_$C(34)
  1. S DIR("?",4)=DIR("?",4)_"Water Contamination at Camp"
  1. S DIR("?",5)="Lejeune"_$C(34)_"."
  1. S DIR("?",6)="Choose from:",DIR("?",7)="Y YES",DIR("?",8)="N NO"
  1. S DIR("?")="Null "_$C(34)_"Blank"_$C(34)
  1. D ^DIR K DIR
  1. I X="@" D G AECL2
  1. . W !!,"Camp Lejeune indicator cannot be deleted if already "
  1. . W "indicated.",!,"Enter '^' to exit.",!
  1. S DGCLIND=$S(Y=1:"Y",Y=0:"N",1:Y)
  1. Q:DGCLIND="^" Q:"^Y^N^"'[(U_DGCLIND_U)
  1. S DGSITE=$P($$SITE^VASITE,U,3)
  1. D SAVECL(DFN,DGCLIND,$P($$NOW^XLFDT,".",1),DGSITE,"VAMC")
  1. Q
  1. ;
  1. SAVECL(DFN,DGCLIND,DGCLDAT,DGSITE,DGSOURCE) ; DG*5.3*909 Save CL-V info
  1. ; Check if CL-V Indicator already No or Yes, then use old date.
  1. N DGCLVREC S DGCLVREC=$G(^DPT(DFN,.3217))
  1. I "^Y^N^"[(U_$P(DGCLVREC,U)_U),$P(DGCLVREC,U,2)]"" D
  1. . S DGCLDAT=$P(DGCLVREC,U,2)
  1. S ^DPT(DFN,.3217)=DGCLIND_U_DGCLDAT_U_DGSITE_U_DGSOURCE
  1. Q
  1. ;
  1. SETCLNO ; DG*5.3*909 Set Camp Lejeune to No when no longer CL Eligible
  1. Q:$P($G(^DPT(DFN,.3217)),U,1)'="Y"
  1. Q:$G(^DPT(DFN,.32171))=1 ; if Locked then don't chg YES to NO
  1. N DGCLE S DGCLE=$$CLE(DFN) Q:DGCLE
  1. D SAVECL(DFN,"N",$P($$NOW^XLFDT,".",1),$P($$SITE^VASITE,U,3),"VAMC")
  1. D AUTOUPD^DGENA2(DFN)
  1. Q
  1. ;