DGMTSC3 ;ALB/RMO/CAW - Means Test Screen Deductible Expense ;23 JAN 1992 11:00 am [ 10/02/92 11:31 AM ]
;;5.3;Registration;**624**;Aug 13, 1993
;
; Input -- DGVINI Veteran Individual Annual Income IEN
; DGVIRI Veteran Income Relation IEN
; DGVPRI Veteran Patient Relation IEN
; Output -- None
;
EN ;Entry point for deductible expense screen
S DGMTSCI=3 D HD^DGMTSCU
D DIS
S DGRNG="1-"_$S('DGDC:1,1:2) G EN^DGMTSCR
EN1 ;Entry point for read processor return
S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)),DGIN1("V")=$G(^DGMT(408.21,DGVINI,1))
S DA=DGVINI,DIE="^DGMT(408.21,",DR="[DGMT ENTER/EDIT EXPENSES]" D ^DIE S:'$D(DGFIN) DGMTOUT=1
I DGIN1("V")'=$G(^DGMT(408.21,DGVINI,1)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE K DA,DIE,DR
I '$G(DGMTOUT),DGDR["102" D EN^DGMTSC31
Q K DGDC,DGDR,DGFIN,DGIN1,DGMTOUT,DGREL,DGVIR0,DGX,DGY,DTOUT,DUOUT
G EN
;
DIS ;Display deductible expenses
N DGCNT,DGDCS,DGDEP,DGIN1,DGINC,DGINR,DGREL,DGVIR0
S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)),DGIN1("V")=$G(^DGMT(408.21,DGVINI,1))
S DGDC=$P(DGVIR0,"^",8) I DGDC D SET^DGMTSC31 S:'$D(DGDCS) DGDC=0
D HIGH^DGMTSCU1(1,DGMTACT) W $J("Gross Medical Expenses: ",33),$S(+$P(DGIN1("V"),"^",12)'<0:$$AMT^DGMTSCU1(+$P(DGIN1("V"),"^",12)),1:"N/A")
W !,$J("Adjusted Medical Expenses: ",36),$S(+$P(DGIN1("V"),"^")'<0:$$AMT^DGMTSCU1(+$P(DGIN1("V"),"^")),1:"N/A")
W !,$J("Funeral and Burial Expenses: ",36),$S('$P(DGVIR0,"^",5)&('$P(DGVIR0,"^",8)):"N/A",1:$$AMT^DGMTSCU1($P(DGIN1("V"),"^",2)))
W !,$J("Veteran's Educational Expenses: ",36),$$AMT^DGMTSCU1($P(DGIN1("V"),"^",3))
W ! D HIGH^DGMTSCU1(2,DGMTACT) W ?7," Child's Education Expenses: ",$S('DGDC:"N/A",1:"") D DIS^DGMTSC31:DGDC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSC3 1721 printed Dec 13, 2024@02:45:20 Page 2
DGMTSC3 ;ALB/RMO/CAW - Means Test Screen Deductible Expense ;23 JAN 1992 11:00 am [ 10/02/92 11:31 AM ]
+1 ;;5.3;Registration;**624**;Aug 13, 1993
+2 ;
+3 ; Input -- DGVINI Veteran Individual Annual Income IEN
+4 ; DGVIRI Veteran Income Relation IEN
+5 ; DGVPRI Veteran Patient Relation IEN
+6 ; Output -- None
+7 ;
EN ;Entry point for deductible expense screen
+1 SET DGMTSCI=3
DO HD^DGMTSCU
+2 DO DIS
+3 SET DGRNG="1-"_$SELECT('DGDC:1,1:2)
GOTO EN^DGMTSCR
EN1 ;Entry point for read processor return
+1 SET DGVIR0=$GET(^DGMT(408.22,DGVIRI,0))
SET DGIN1("V")=$GET(^DGMT(408.21,DGVINI,1))
+2 SET DA=DGVINI
SET DIE="^DGMT(408.21,"
SET DR="[DGMT ENTER/EDIT EXPENSES]"
DO ^DIE
if '$DATA(DGFIN)
SET DGMTOUT=1
+3 IF DGIN1("V")'=$GET(^DGMT(408.21,DGVINI,1))
SET DR="103////^S X=DUZ;104///^S X=""NOW"""
DO ^DIE
KILL DA,DIE,DR
+4 IF '$GET(DGMTOUT)
IF DGDR["102"
DO EN^DGMTSC31
Q KILL DGDC,DGDR,DGFIN,DGIN1,DGMTOUT,DGREL,DGVIR0,DGX,DGY,DTOUT,DUOUT
+1 GOTO EN
+2 ;
DIS ;Display deductible expenses
+1 NEW DGCNT,DGDCS,DGDEP,DGIN1,DGINC,DGINR,DGREL,DGVIR0
+2 SET DGVIR0=$GET(^DGMT(408.22,DGVIRI,0))
SET DGIN1("V")=$GET(^DGMT(408.21,DGVINI,1))
+3 SET DGDC=$PIECE(DGVIR0,"^",8)
IF DGDC
DO SET^DGMTSC31
if '$DATA(DGDCS)
SET DGDC=0
+4 DO HIGH^DGMTSCU1(1,DGMTACT)
WRITE $JUSTIFY("Gross Medical Expenses: ",33),$SELECT(+$PIECE(DGIN1("V"),"^",12)'<0:$$AMT^DGMTSCU1(+$PIECE(DGIN1("V"),"^",12)),1:"N/A")
+5 WRITE !,$JUSTIFY("Adjusted Medical Expenses: ",36),$SELECT(+$PIECE(DGIN1("V"),"^")'<0:$$AMT^DGMTSCU1(+$PIECE(DGIN1("V"),"^")),1:"N/A")
+6 WRITE !,$JUSTIFY("Funeral and Burial Expenses: ",36),$SELECT('$PIECE(DGVIR0,"^",5)&('$PIECE(DGVIR0,"^",8)):"N/A",1:$$AMT^DGMTSCU1($PIECE(DGIN1("V"),"^",2)))
+7 WRITE !,$JUSTIFY("Veteran's Educational Expenses: ",36),$$AMT^DGMTSCU1($PIECE(DGIN1("V"),"^",3))
+8 WRITE !
DO HIGH^DGMTSCU1(2,DGMTACT)
WRITE ?7," Child's Education Expenses: ",$SELECT('DGDC:"N/A",1:"")
if DGDC
DO DIS^DGMTSC31
+9 QUIT