EASECSC4 ;ALB/PHH,LBD - LTC Co-Pay Test Screen Assets ;10 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,40**;Mar 15, 2001
;
; Input -- DFN Patient IEN
; DGMTDT Date of Test
; DGMTYPT Type of Test 3=LTC Co-Pay
; DGMTPAR Annual Test Parameter Array
; DGVINI Veteran Individual Annual Income IEN
; DGVIRI Veteran Income Relation IEN
; DGVPRI Veteran Patient Relation IEN
; DGFORM 10-10EC Format (1=Revised; 0=Original)
; Output -- None
;
EN ;Entry point for net worth screen
S DGMTSCI=4 D HD^EASECSCU
D DIS
S DGRNG=$S($G(DGFORM):"1-5",1:"1-6") G EN^EASECSCR
;
EN1 ;Entry point for read processor return
D ALL^EASECU21(DFN,"S",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
G EN
;
DIS ;Display net worth
N DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCNT
D DEP^EASECSU3,INC^EASECSU3 S DGCNT=1
; Revised 10-10EC form uses separate columns for veteran and spouse
; added for LTC Phase IV (EAS*1*40)
I $G(DGFORM) W !?39,"Veteran" W:DGSP ?56,"Spouse" W ?73,"Total"
E W !?39,"Veteran" W:DGSP " and Spouse" W ?73,"Total"
W !?36,"------------------------------------------"
D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN2,6,"Residence")
D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN2,7,"Other Residences/Land/Farm/or Ranch")
D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN2,8,"Vehicle(s)")
; Revised 10-10EC format, added for LTC IV (EAS*1*40)
I $G(DGFORM) D
.D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN2,1,"Cash, Stocks, Mutual Funds")
.D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN2,9,"Other Liquid Assets")
; Original 10-10EC format
I '$G(DGFORM) D
.D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN2,1,"Cash")
.D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN2,2,"Stocks, Bonds, Mutual Funds, SEP's")
.D HIGH^DGMTSCU1(6,DGMTACT),FLD(.DGIN2,9,"Other Liquid Assets")
W !?56,"Total -->",?66,$J($$AMT^DGMTSCU1(DGNWT),12)
DISQ Q
;
FLD(DGIN,DGPCE,DGTXT) ;Display income fields
;
; Input -- DGIN as Individual Annual Income 0 node for vet,
; spouse, and dependents
; DGRPCE as piece position wanted
; DGTXT as income description
;
; Also keeps running total if DGGTOT is defined (grand
; total)
;
N DGTOT,I
I '$D(DGBL) S $P(DGBL," ",26)=""
W:DGCNT<10 " "
W " ",$E(DGTXT_DGBL,1,26)
W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),15)
; Display spouse amount if married (only applies to new 10-10EC form)
; Added for LTC Phase IV (EAS*1*40)
W " ",$S($D(DGIN("S"))&($G(DGFORM)):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),15),1:$E(DGBL,1,15))
W " "
S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
S DGCNT=DGCNT+1
Q
;
EDT ;Edit net worth fields
N DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR
D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
S DGIN2=$G(^DGMT(408.21,DGINI,2))
; If this is the new 10-10EC form use the template [EASEC ENTER/EDIT
; ASSETS NEW]. Added for LTC IV (EAS*1*40).
S DA=DGINI,DIE="^DGMT(408.21,",DR="[EASEC ENTER/EDIT ASSETS"_$S($G(DGFORM):" NEW]",1:"]")
D ^DIE S:'$D(DGFIN) DGMTOUT=1
I DGIN2'=$G(^DGMT(408.21,DGINI,2)) D
.S DR="103////^S X=DUZ;104///^S X=""NOW"""
.I '$G(^DGMT(408.21,DGINI,"MT")) S DR=DR_";31////^S X=$G(DGMTI)"
.D ^DIE
EDTQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECSC4 3732 printed Nov 22, 2024@17:04:20 Page 2
EASECSC4 ;ALB/PHH,LBD - LTC Co-Pay Test Screen Assets ;10 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,40**;Mar 15, 2001
+2 ;
+3 ; Input -- DFN Patient IEN
+4 ; DGMTDT Date of Test
+5 ; DGMTYPT Type of Test 3=LTC Co-Pay
+6 ; DGMTPAR Annual Test Parameter Array
+7 ; DGVINI Veteran Individual Annual Income IEN
+8 ; DGVIRI Veteran Income Relation IEN
+9 ; DGVPRI Veteran Patient Relation IEN
+10 ; DGFORM 10-10EC Format (1=Revised; 0=Original)
+11 ; Output -- None
+12 ;
EN ;Entry point for net worth screen
+1 SET DGMTSCI=4
DO HD^EASECSCU
+2 DO DIS
+3 SET DGRNG=$SELECT($GET(DGFORM):"1-5",1:"1-6")
GOTO EN^EASECSCR
+4 ;
EN1 ;Entry point for read processor return
+1 DO ALL^EASECU21(DFN,"S",DGMTDT,"IPR",$SELECT($GET(DGMTI):DGMTI,1:""))
+2 IF DGX!($GET(DGSELTY)["V")
SET DGPRI=DGVPRI
SET DGPRTY="V"
DO EDT
+3 IF '$GET(DGMTOUT)&($GET(DGSEL)["S")&(DGX!($GET(DGSELTY)["S"))
SET DGPRI=+DGREL("S")
SET DGPRTY="S"
DO EDT
Q KILL DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
+1 GOTO EN
+2 ;
DIS ;Display net worth
+1 NEW DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCNT
+2 DO DEP^EASECSU3
DO INC^EASECSU3
SET DGCNT=1
+3 ; Revised 10-10EC form uses separate columns for veteran and spouse
+4 ; added for LTC Phase IV (EAS*1*40)
+5 IF $GET(DGFORM)
WRITE !?39,"Veteran"
if DGSP
WRITE ?56,"Spouse"
WRITE ?73,"Total"
+6 IF '$TEST
WRITE !?39,"Veteran"
if DGSP
WRITE " and Spouse"
WRITE ?73,"Total"
+7 WRITE !?36,"------------------------------------------"
+8 DO HIGH^DGMTSCU1(1,DGMTACT)
DO FLD(.DGIN2,6,"Residence")
+9 DO HIGH^DGMTSCU1(2,DGMTACT)
DO FLD(.DGIN2,7,"Other Residences/Land/Farm/or Ranch")
+10 DO HIGH^DGMTSCU1(3,DGMTACT)
DO FLD(.DGIN2,8,"Vehicle(s)")
+11 ; Revised 10-10EC format, added for LTC IV (EAS*1*40)
+12 IF $GET(DGFORM)
Begin DoDot:1
+13 DO HIGH^DGMTSCU1(4,DGMTACT)
DO FLD(.DGIN2,1,"Cash, Stocks, Mutual Funds")
+14 DO HIGH^DGMTSCU1(5,DGMTACT)
DO FLD(.DGIN2,9,"Other Liquid Assets")
End DoDot:1
+15 ; Original 10-10EC format
+16 IF '$GET(DGFORM)
Begin DoDot:1
+17 DO HIGH^DGMTSCU1(4,DGMTACT)
DO FLD(.DGIN2,1,"Cash")
+18 DO HIGH^DGMTSCU1(5,DGMTACT)
DO FLD(.DGIN2,2,"Stocks, Bonds, Mutual Funds, SEP's")
+19 DO HIGH^DGMTSCU1(6,DGMTACT)
DO FLD(.DGIN2,9,"Other Liquid Assets")
End DoDot:1
+20 WRITE !?56,"Total -->",?66,$JUSTIFY($$AMT^DGMTSCU1(DGNWT),12)
DISQ QUIT
+1 ;
FLD(DGIN,DGPCE,DGTXT) ;Display income fields
+1 ;
+2 ; Input -- DGIN as Individual Annual Income 0 node for vet,
+3 ; spouse, and dependents
+4 ; DGRPCE as piece position wanted
+5 ; DGTXT as income description
+6 ;
+7 ; Also keeps running total if DGGTOT is defined (grand
+8 ; total)
+9 ;
+10 NEW DGTOT,I
+11 IF '$DATA(DGBL)
SET $PIECE(DGBL," ",26)=""
+12 if DGCNT<10
WRITE " "
+13 WRITE " ",$EXTRACT(DGTXT_DGBL,1,26)
+14 WRITE $JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("V"),"^",DGPCE)),15)
+15 ; Display spouse amount if married (only applies to new 10-10EC form)
+16 ; Added for LTC Phase IV (EAS*1*40)
+17 WRITE " ",$SELECT($DATA(DGIN("S"))&($GET(DGFORM)):$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN("S"),"^",DGPCE)),15),1:$EXTRACT(DGBL,1,15))
+18 WRITE " "
+19 SET DGTOT=""
SET I=""
FOR
SET I=$ORDER(DGIN(I))
if I=""
QUIT
IF $PIECE(DGIN(I),"^",DGPCE)]""
SET DGTOT=DGTOT+$PIECE(DGIN(I),"^",DGPCE)
+20 WRITE " ",$JUSTIFY($$AMT^DGMTSCU1(DGTOT),12)
+21 SET DGCNT=DGCNT+1
+22 QUIT
+23 ;
EDT ;Edit net worth fields
+1 NEW DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR
+2 DO GETIENS^EASECU2(DFN,DGPRI,DGMTDT)
if DGERR
GOTO EDTQ
+3 IF $GET(DGSEL)]""
WRITE !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
+4 SET DGIN2=$GET(^DGMT(408.21,DGINI,2))
+5 ; If this is the new 10-10EC form use the template [EASEC ENTER/EDIT
+6 ; ASSETS NEW]. Added for LTC IV (EAS*1*40).
+7 SET DA=DGINI
SET DIE="^DGMT(408.21,"
SET DR="[EASEC ENTER/EDIT ASSETS"_$SELECT($GET(DGFORM):" NEW]",1:"]")
+8 DO ^DIE
if '$DATA(DGFIN)
SET DGMTOUT=1
+9 IF DGIN2'=$GET(^DGMT(408.21,DGINI,2))
Begin DoDot:1
+10 SET DR="103////^S X=DUZ;104///^S X=""NOW"""
+11 IF '$GET(^DGMT(408.21,DGINI,"MT"))
SET DR=DR_";31////^S X=$G(DGMTI)"
+12 DO ^DIE
End DoDot:1
EDTQ QUIT
