| 1 | DGMTSC2 ;ALB/RMO/CAW - Means Test Screen Income ;23 JAN 1992 11:00 am [ 10/02/92 8:46 AM ]
|
---|
| 2 | ;;5.3;Registration;**45**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | ; Input -- DFN Patient IEN
|
---|
| 5 | ; DGMTDT Date of Test
|
---|
| 6 | ; DGVINI Veteran Individual Annual Income IEN
|
---|
| 7 | ; DGVIRI Veteran Income Relation IEN
|
---|
| 8 | ; DGVPRI Veteran Patient Relation IEN
|
---|
| 9 | ; DGMTI Means Test IEN
|
---|
| 10 | ; Output -- None
|
---|
| 11 | ;
|
---|
| 12 | EN ;Entry point for previous calendar year income screen
|
---|
| 13 | S DGMTSCI=2 D HD^DGMTSCU
|
---|
| 14 | D DIS
|
---|
| 15 | S DGRNG="1-10" G EN^DGMTSCR
|
---|
| 16 | ;
|
---|
| 17 | EN1 ;Entry point for read processor return
|
---|
| 18 | D ALL^DGMTU21(DFN,"CS",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
|
---|
| 19 | I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
|
---|
| 20 | I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
|
---|
| 21 | I '$G(DGMTOUT)&($G(DGSEL)["C")&(DGX!($G(DGSELTY)["C")) S DGPRTY="C",DGCNT=0 F S DGCNT=$O(DGREL("C",DGCNT)) Q:'DGCNT!($G(DGMTOUT)) D
|
---|
| 22 | .D CHK^DGMTSCU2 I Y S DGPRI=+DGREL("C",DGCNT) D EDT
|
---|
| 23 | Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
|
---|
| 24 | G EN
|
---|
| 25 | ;
|
---|
| 26 | DIS ;Display income
|
---|
| 27 | N DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,DGCNT
|
---|
| 28 | D DEP^DGMTSCU2,INC^DGMTSCU3 S DGCNT=1
|
---|
| 29 | W !!?34,"Veteran" W:DGSP ?46,"Spouse" W:DGDC ?56,"Children" W ?73,"Total"
|
---|
| 30 | W !?31,"-----------------------------------------------"
|
---|
| 31 | D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN0,8,"Social Security (Not SSI)")
|
---|
| 32 | D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN0,9,"U.S. Civil Service")
|
---|
| 33 | D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN0,10,"U.S. Railroad Retirement")
|
---|
| 34 | D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN0,11,"Military Retirement")
|
---|
| 35 | D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN0,12,"Unemployment Compensation")
|
---|
| 36 | D HIGH^DGMTSCU1(6,DGMTACT),FLD(.DGIN0,13,"Other Retirement")
|
---|
| 37 | D HIGH^DGMTSCU1(7,DGMTACT),FLD(.DGIN0,14,"Total Employment Income")
|
---|
| 38 | D HIGH^DGMTSCU1(8,DGMTACT),FLD(.DGIN0,15,"Interest,Dividend,Annuity")
|
---|
| 39 | D HIGH^DGMTSCU1(9,DGMTACT),FLD(.DGIN0,16,"Workers Comp or Black Lung")
|
---|
| 40 | D HIGH^DGMTSCU1(10,DGMTACT),FLD(.DGIN0,17,"All Other Income")
|
---|
| 41 | W !?51,"Total -->",?66,$J($$AMT^DGMTSCU1(DGINT),12)
|
---|
| 42 | Q
|
---|
| 43 | ;
|
---|
| 44 | FLD(DGIN,DGPCE,DGTXT) ;Display income fields
|
---|
| 45 | ;
|
---|
| 46 | ; Input -- DGIN as Individual Annual Income 0 node for vet,
|
---|
| 47 | ; spouse, and dependents
|
---|
| 48 | ; DGPCE as piece position wanted
|
---|
| 49 | ; DGTXT as income description
|
---|
| 50 | ;
|
---|
| 51 | ; Also keeps running total if DGGTOT is defined (grand
|
---|
| 52 | ; total)
|
---|
| 53 | ;
|
---|
| 54 | N DGTOT,I
|
---|
| 55 | I '$D(DGBL) S $P(DGBL," ",26)=""
|
---|
| 56 | W:DGCNT<10 " "
|
---|
| 57 | W " ",$E(DGTXT_DGBL,1,26)
|
---|
| 58 | W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10)
|
---|
| 59 | W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
|
---|
| 60 | W " ",$S($D(DGIN("C")):$J($$AMT^DGMTSCU1($P(DGIN("C"),"^",DGPCE)),11),1:$E(DGBL,1,11))
|
---|
| 61 | S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
|
---|
| 62 | W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
|
---|
| 63 | S DGCNT=DGCNT+1
|
---|
| 64 | Q
|
---|
| 65 | ;
|
---|
| 66 | EDT ;Edit income fields
|
---|
| 67 | N DA,DGERR,DGFIN,DGINI,DGIN0,DGIRI,DIE,DR
|
---|
| 68 | D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
|
---|
| 69 | I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
|
---|
| 70 | S DGIN0=$G(^DGMT(408.21,DGINI,0))
|
---|
| 71 | S DA=DGINI,DIE="^DGMT(408.21,",DR="[DGMT ENTER/EDIT ANNUAL INCOME]" D ^DIE S:'$D(DGFIN) DGMTOUT=1
|
---|
| 72 | I DGIN0'=$G(^DGMT(408.21,DGINI,0)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
|
---|
| 73 | EDTQ Q
|
---|