- 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 Apr 23, 2025@18:08:41 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
