EASECU21 ;ALB/LBD - Income Utilities Cont. ;14 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
;
; This routine was modified from DGMTU21 for LTC Co-pay
;
ALL(DFN,DGTYPE,DGDT,DGRTY,DGMT) ;Select patient relation, individual annual
; income and income relation arrays of internal
; entry numbers
; Input -- DFN Patient file IEN
; DGTYPE Type of Relation which can
; contain:
; V for veteran
; S for spouse
; C for dependent children
; or
; D for all dependents
; DGDT Date/Time
; DGRTY Type of Array to Return
; which can contain:
; I for Ind Annual Income
; P for Patient Relation
; R for Income Relation
; (Optional - default IPR)
; DGMT IFN of Means Test (optional)
; Output -- DGREL Patient Relation IEN Array
; DGINC Individual Annual Income IEN Array
; DGINR Income Relation IEN Array
; DGDEP Number of Dependents
K DGINC,DGINR,DGREL
N DGCNT,DGLY,DGPRTY
; for LTC co-pay DGLY is set to current year
S:'$D(DGRTY) DGRTY="IPR" S DGLY=$E(DGDT,1,3)_"0000"
D GETREL^DGMTU11(DFN,DGTYPE,DGLY,$G(DGMT))
S DGPRTY="" F S DGPRTY=$O(DGREL(DGPRTY)) Q:DGPRTY="" D SET
I DGRTY'["P" K DGREL
ALLQ Q
;
SET ;Set individual annual income and income relation arrays
N DGCNT,DGPRI,DGINI,DGIRI
I "CD"[DGPRTY S DGCNT=0 F S DGCNT=$O(DGREL(DGPRTY,DGCNT)) Q:'DGCNT D
.S DGPRI=+DGREL(DGPRTY,DGCNT) D GET
.I DGINI,DGRTY["I" S DGINC(DGPRTY,DGCNT)=DGINI
.I DGIRI,DGRTY["R" S DGINR(DGPRTY,DGCNT)=DGIRI
I "SV"[DGPRTY D
.S DGPRI=+DGREL(DGPRTY) D GET
.I DGINI,DGRTY["I" S DGINC(DGPRTY)=DGINI
.I DGIRI,DGRTY["R" S DGINR(DGPRTY)=DGIRI
Q
;
GET ;Look-up individual annual income and income relation IEN
S DGINI=+$$IAI^DGMTU3(DGPRI,DGLY,$S($G(DGMT):$P($G(^DGMT(408.31,DGMT,0)),"^",19),1:1))
S DGIRI=+$O(^DGMT(408.22,"AIND",DGINI,0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECU21 2610 printed Dec 13, 2024@01:54:20 Page 2
EASECU21 ;ALB/LBD - Income Utilities Cont. ;14 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
+2 ;
+3 ; This routine was modified from DGMTU21 for LTC Co-pay
+4 ;
ALL(DFN,DGTYPE,DGDT,DGRTY,DGMT) ;Select patient relation, individual annual
+1 ; income and income relation arrays of internal
+2 ; entry numbers
+3 ; Input -- DFN Patient file IEN
+4 ; DGTYPE Type of Relation which can
+5 ; contain:
+6 ; V for veteran
+7 ; S for spouse
+8 ; C for dependent children
+9 ; or
+10 ; D for all dependents
+11 ; DGDT Date/Time
+12 ; DGRTY Type of Array to Return
+13 ; which can contain:
+14 ; I for Ind Annual Income
+15 ; P for Patient Relation
+16 ; R for Income Relation
+17 ; (Optional - default IPR)
+18 ; DGMT IFN of Means Test (optional)
+19 ; Output -- DGREL Patient Relation IEN Array
+20 ; DGINC Individual Annual Income IEN Array
+21 ; DGINR Income Relation IEN Array
+22 ; DGDEP Number of Dependents
+23 KILL DGINC,DGINR,DGREL
+24 NEW DGCNT,DGLY,DGPRTY
+25 ; for LTC co-pay DGLY is set to current year
+26 if '$DATA(DGRTY)
SET DGRTY="IPR"
SET DGLY=$EXTRACT(DGDT,1,3)_"0000"
+27 DO GETREL^DGMTU11(DFN,DGTYPE,DGLY,$GET(DGMT))
+28 SET DGPRTY=""
FOR
SET DGPRTY=$ORDER(DGREL(DGPRTY))
if DGPRTY=""
QUIT
DO SET
+29 IF DGRTY'["P"
KILL DGREL
ALLQ QUIT
+1 ;
SET ;Set individual annual income and income relation arrays
+1 NEW DGCNT,DGPRI,DGINI,DGIRI
+2 IF "CD"[DGPRTY
SET DGCNT=0
FOR
SET DGCNT=$ORDER(DGREL(DGPRTY,DGCNT))
if 'DGCNT
QUIT
Begin DoDot:1
+3 SET DGPRI=+DGREL(DGPRTY,DGCNT)
DO GET
+4 IF DGINI
IF DGRTY["I"
SET DGINC(DGPRTY,DGCNT)=DGINI
+5 IF DGIRI
IF DGRTY["R"
SET DGINR(DGPRTY,DGCNT)=DGIRI
End DoDot:1
+6 IF "SV"[DGPRTY
Begin DoDot:1
+7 SET DGPRI=+DGREL(DGPRTY)
DO GET
+8 IF DGINI
IF DGRTY["I"
SET DGINC(DGPRTY)=DGINI
+9 IF DGIRI
IF DGRTY["R"
SET DGINR(DGPRTY)=DGIRI
End DoDot:1
+10 QUIT
+11 ;
GET ;Look-up individual annual income and income relation IEN
+1 SET DGINI=+$$IAI^DGMTU3(DGPRI,DGLY,$SELECT($GET(DGMT):$PIECE($GET(^DGMT(408.31,DGMT,0)),"^",19),1:1))
+2 SET DGIRI=+$ORDER(^DGMT(408.22,"AIND",DGINI,0))
+3 QUIT
