Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMTSC2

DGMTSC2.m

Go to the documentation of this file.
  1. DGMTSC2 ;ALB/RMO/CAW - Means Test Screen Income ; 8/1/08 1:15pm
  1. ;;5.3;Registration;**45,688**;Aug 13, 1993;Build 29
  1. ;
  1. ; Input -- DFN Patient IEN
  1. ; DGMTDT Date of Test
  1. ; DGVINI Veteran Individual Annual Income IEN
  1. ; DGVIRI Veteran Income Relation IEN
  1. ; DGVPRI Veteran Patient Relation IEN
  1. ; DGMTI Means Test IEN
  1. ; Output -- None
  1. ;
  1. EN ;Entry point for previous calendar year income screen
  1. S DGMTSCI=2 D HD^DGMTSCU
  1. D DIS
  1. S DGRNG="1-10" G EN^DGMTSCR
  1. ;
  1. EN1 ;Entry point for read processor return
  1. D ALL^DGMTU21(DFN,"CS",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
  1. I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
  1. I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
  1. 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
  1. .D CHK^DGMTSCU2 I Y S DGPRI=+DGREL("C",DGCNT) D EDT
  1. Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
  1. G EN
  1. ;
  1. DIS ;Display income
  1. N DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,DGCNT
  1. D DEP^DGMTSCU2,INC^DGMTSCU3 S DGCNT=1
  1. W !!?35,"Veteran" W:DGSP ?47,"Spouse" W:DGDC ?57,"Children" W ?73,"Total"
  1. W !?31,"-----------------------------------------------"
  1. D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN0,8,"Social Security (Not SSI)")
  1. D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN0,9,"U.S. Civil Service")
  1. D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN0,10,"U.S. Railroad Retirement")
  1. D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN0,11,"Military Retirement")
  1. D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN0,12,"Unemployment Compensation")
  1. D HIGH^DGMTSCU1(6,DGMTACT),FLD(.DGIN0,13,"Other Retirement")
  1. D HIGH^DGMTSCU1(7,DGMTACT),FLD(.DGIN0,14,"Total Employment Income")
  1. D HIGH^DGMTSCU1(8,DGMTACT),FLD(.DGIN0,15,"Interest,Dividend,Annuity")
  1. D HIGH^DGMTSCU1(9,DGMTACT),FLD(.DGIN0,16,"Workers Comp or Black Lung")
  1. D HIGH^DGMTSCU1(10,DGMTACT),FLD(.DGIN0,17,"All Other Income")
  1. W !?52,"Total -->",?67,$J($$AMT^DGMTSCU1(DGINT),12)
  1. Q
  1. ;
  1. FLD(DGIN,DGPCE,DGTXT) ;Display income fields
  1. ;
  1. ; Input -- DGIN as Individual Annual Income 0 node for vet,
  1. ; spouse, and dependents
  1. ; DGPCE as piece position wanted
  1. ; DGTXT as income description
  1. ;
  1. ; Also keeps running total if DGGTOT is defined (grand
  1. ; total)
  1. ;
  1. N DGTOT,I
  1. I '$D(DGBL) S $P(DGBL," ",28)=""
  1. W:DGCNT<10 " "
  1. W " ",$E(DGTXT_DGBL,1,28)
  1. W:$D(DGFV2) $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),11)
  1. W:'$D(DGFV2) $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),9)
  1. W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
  1. W " ",$S($D(DGIN("C")):$J($$AMT^DGMTSCU1($P(DGIN("C"),"^",DGPCE)),11),1:$E(DGBL,1,11))
  1. S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
  1. W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
  1. S DGCNT=DGCNT+1
  1. Q
  1. ;
  1. EDT ;Edit income fields
  1. N DA,DGERR,DGFIN,DGINI,DGIN0,DGIRI,DIE,DR
  1. D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
  1. I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
  1. S DGIN0=$G(^DGMT(408.21,DGINI,0))
  1. S DR="[DGMT ENTER/EDIT ANNUAL INCOME]"
  1. S DA=DGINI,DIE="^DGMT(408.21," D ^DIE S:'$D(DGFIN) DGMTOUT=1
  1. I DGIN0'=$G(^DGMT(408.21,DGINI,0)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
  1. EDTQ Q