- 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 Jan 18, 2025@03:46:20 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