DGMTU3 ;ALB/MLI/GN/LBD - Internal Entry Number Utility Calls ; 2/20/03 8:45am
;;5.3;Registration;**33,45,137,182,300,433,499,518**;Aug 13, 1993
;
; This routine will return the IENs for the primary income
; test from various files.
;
MTIEN(TYPE,DFN,INVDT) ; get last primary income test for date
;
; Input -- TYPE as 1 for means test, 2 for copay test
; DFN as Patient IEN
; INVDT as inverse date for search
; Output -- Record IEN
;
N I
F I=0:0 S I=$O(^DGMT(408.31,"AID",TYPE,DFN,INVDT,I)) Q:'I I +$G(^DGMT(408.31,I,"PRIM")) Q
Q I
;
;
IAI(REL,YEAR,DGMTYPT) ; get individual annual income IEN for primary income test/pt relation
;
; Input -- REL as IEN of PATIENT RELATION file
; YEAR as income year in question
; DGMTYPT as type of test (optional if not defined means test
; will be assumed)
; Output -- Record IEN
;
N DFN,I,IEN,INR,MTIEN,LAST,DGDT,LTCIEN
S DFN=+$G(^DGPR(408.12,+REL,0)) I 'DFN G IAIQ
;
;DG*5.3*499, change to if structure and check for presence of DGMTI
; it is not defined when coming from Bene travel menus
;LTC Phase III (DG*5.3*518) - add setting of LTCIEN
;
; if user selects view option & DGMTI exists, set IEN=DGMTI
I $G(DGMTACT)="VEW",$G(DGMTI) D
. S (MTIEN,LTCIEN)=DGMTI
E D
. S DGDT=$E(YEAR,1,3)+1_"1231.99"
. S MTIEN=$$LST^DGMTU(DFN,DGDT,$S($G(DGMTYPT):DGMTYPT,1:1))
. S LTCIEN=$S($G(DGMTI):DGMTI,1:$$LST^EASECU(DFN,(YEAR+1231.99),3))
;
I MTIEN S LAST=0 D
. F I=0:0 S I=$O(^DGMT(408.21,"AI",+REL,-YEAR,I)) Q:'I S LAST=I,INR=$O(^DGMT(408.22,"AIND",I,"")) I +$G(^DGMT(408.22,+INR,"MT"))=+MTIEN Q
. S IEN=LAST
. ; The following was added for LTC Copay Phase II (DG*5.3*433)
. ; If the IAI record is associated with a LTC Copay Test (type 3),
. ; don't return it if DGMTYPT is not type 3.
. Q:'$G(^DGMT(408.21,IEN,"MT"))
. I $P($G(^DGMT(408.31,+^DGMT(408.21,IEN,"MT"),0)),U,19)=3,$G(DGMTYPT)'=3 S IEN=""
. ; If DGMTYPT=3 make sure the IAI record is associated with the
. ; correct LTC Copay test. Added for LTC Phase III (DG*5.3*518)
. I $G(DGMTYPT)=3,+^DGMT(408.21,IEN,"MT")'=+LTCIEN S IEN=""
;
; if veteran doesn't have a mt
I 'MTIEN D
. ; The following was added for LTC Copay Phase II (DG*5.3*433)
. ; If the IAI record is associated with a LTC Copay Test (type 3),
. ; don't return it if DGMTYPT is not type 3.
. S IEN="" F I=0:0 S I=$O(^DGMT(408.21,"AI",+REL,-YEAR,I)) Q:'I S IEN=I Q:'$G(^DGMT(408.21,IEN,"MT")) D Q:IEN
.. I $P($G(^DGMT(408.31,+^DGMT(408.21,IEN,"MT"),0)),U,19)=3,$G(DGMTYPT)'=3 S IEN=""
.. ; If DGMTYPT=3 make sure the IAI record is associated with the
.. ; correct LTC Copay test. Added for LTC Phase III (DG*5.3*518)
.. I $G(DGMTYPT)=3,+^DGMT(408.21,IEN,"MT")'=+LTCIEN S IEN=""
IAIQ Q $G(IEN)
;
;
MTIENLT(TYPE,DFN,INVDTL) ; get last primary income test on or before date
;
; Input -- TYPE as 1 for means test, 2 for copay test
; DFN as Patient IEN
; INVDTL as inverse date for search
; Output -- Record IEN
;
N K
S K=""
F S INVDTL=$O(^DGMT(408.31,"AID",TYPE,DFN,INVDTL)) Q:'INVDTL S K=$$MTIEN(TYPE,DFN,INVDTL) Q:K
Q K
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTU3 3206 printed Dec 13, 2024@02:45:38 Page 2
DGMTU3 ;ALB/MLI/GN/LBD - Internal Entry Number Utility Calls ; 2/20/03 8:45am
+1 ;;5.3;Registration;**33,45,137,182,300,433,499,518**;Aug 13, 1993
+2 ;
+3 ; This routine will return the IENs for the primary income
+4 ; test from various files.
+5 ;
MTIEN(TYPE,DFN,INVDT) ; get last primary income test for date
+1 ;
+2 ; Input -- TYPE as 1 for means test, 2 for copay test
+3 ; DFN as Patient IEN
+4 ; INVDT as inverse date for search
+5 ; Output -- Record IEN
+6 ;
+7 NEW I
+8 FOR I=0:0
SET I=$ORDER(^DGMT(408.31,"AID",TYPE,DFN,INVDT,I))
if 'I
QUIT
IF +$GET(^DGMT(408.31,I,"PRIM"))
QUIT
+9 QUIT I
+10 ;
+11 ;
IAI(REL,YEAR,DGMTYPT) ; get individual annual income IEN for primary income test/pt relation
+1 ;
+2 ; Input -- REL as IEN of PATIENT RELATION file
+3 ; YEAR as income year in question
+4 ; DGMTYPT as type of test (optional if not defined means test
+5 ; will be assumed)
+6 ; Output -- Record IEN
+7 ;
+8 NEW DFN,I,IEN,INR,MTIEN,LAST,DGDT,LTCIEN
+9 SET DFN=+$GET(^DGPR(408.12,+REL,0))
IF 'DFN
GOTO IAIQ
+10 ;
+11 ;DG*5.3*499, change to if structure and check for presence of DGMTI
+12 ; it is not defined when coming from Bene travel menus
+13 ;LTC Phase III (DG*5.3*518) - add setting of LTCIEN
+14 ;
+15 ; if user selects view option & DGMTI exists, set IEN=DGMTI
+16 IF $GET(DGMTACT)="VEW"
IF $GET(DGMTI)
Begin DoDot:1
+17 SET (MTIEN,LTCIEN)=DGMTI
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 SET DGDT=$EXTRACT(YEAR,1,3)+1_"1231.99"
+20 SET MTIEN=$$LST^DGMTU(DFN,DGDT,$SELECT($GET(DGMTYPT):DGMTYPT,1:1))
+21 SET LTCIEN=$SELECT($GET(DGMTI):DGMTI,1:$$LST^EASECU(DFN,(YEAR+1231.99),3))
End DoDot:1
+22 ;
+23 IF MTIEN
SET LAST=0
Begin DoDot:1
+24 FOR I=0:0
SET I=$ORDER(^DGMT(408.21,"AI",+REL,-YEAR,I))
if 'I
QUIT
SET LAST=I
SET INR=$ORDER(^DGMT(408.22,"AIND",I,""))
IF +$GET(^DGMT(408.22,+INR,"MT"))=+MTIEN
QUIT
+25 SET IEN=LAST
+26 ; The following was added for LTC Copay Phase II (DG*5.3*433)
+27 ; If the IAI record is associated with a LTC Copay Test (type 3),
+28 ; don't return it if DGMTYPT is not type 3.
+29 if '$GET(^DGMT(408.21,IEN,"MT"))
QUIT
+30 IF $PIECE($GET(^DGMT(408.31,+^DGMT(408.21,IEN,"MT"),0)),U,19)=3
IF $GET(DGMTYPT)'=3
SET IEN=""
+31 ; If DGMTYPT=3 make sure the IAI record is associated with the
+32 ; correct LTC Copay test. Added for LTC Phase III (DG*5.3*518)
+33 IF $GET(DGMTYPT)=3
IF +^DGMT(408.21,IEN,"MT")'=+LTCIEN
SET IEN=""
End DoDot:1
+34 ;
+35 ; if veteran doesn't have a mt
+36 IF 'MTIEN
Begin DoDot:1
+37 ; The following was added for LTC Copay Phase II (DG*5.3*433)
+38 ; If the IAI record is associated with a LTC Copay Test (type 3),
+39 ; don't return it if DGMTYPT is not type 3.
+40 SET IEN=""
FOR I=0:0
SET I=$ORDER(^DGMT(408.21,"AI",+REL,-YEAR,I))
if 'I
QUIT
SET IEN=I
if '$GET(^DGMT(408.21,IEN,"MT"))
QUIT
Begin DoDot:2
+41 IF $PIECE($GET(^DGMT(408.31,+^DGMT(408.21,IEN,"MT"),0)),U,19)=3
IF $GET(DGMTYPT)'=3
SET IEN=""
+42 ; If DGMTYPT=3 make sure the IAI record is associated with the
+43 ; correct LTC Copay test. Added for LTC Phase III (DG*5.3*518)
+44 IF $GET(DGMTYPT)=3
IF +^DGMT(408.21,IEN,"MT")'=+LTCIEN
SET IEN=""
End DoDot:2
if IEN
QUIT
End DoDot:1
IAIQ QUIT $GET(IEN)
+1 ;
+2 ;
MTIENLT(TYPE,DFN,INVDTL) ; get last primary income test on or before date
+1 ;
+2 ; Input -- TYPE as 1 for means test, 2 for copay test
+3 ; DFN as Patient IEN
+4 ; INVDTL as inverse date for search
+5 ; Output -- Record IEN
+6 ;
+7 NEW K
+8 SET K=""
+9 FOR
SET INVDTL=$ORDER(^DGMT(408.31,"AID",TYPE,DFN,INVDTL))
if 'INVDTL
QUIT
SET K=$$MTIEN(TYPE,DFN,INVDTL)
if K
QUIT
+10 QUIT K
