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

DGMTSC4.m

Go to the documentation of this file. 
  1. DGMTSC4 ;ALB/RMO/CAW,LBD - Means Test Screen Net Worth ; 11/7/03 1:44pm
  1.  ;;5.3;Registration;**45,130,456,540,567,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ; Input  -- DFN      Patient IEN
  1.  ;           DGMTDT   Date of Test
  1.  ;           DGMTYPT  Type of Test 1=MT 2=COPAY
  1.  ;           DGMTPAR  Annual Means Test Parameter Array
  1.  ;           DGVINI   Veteran Individual Annual Income IEN
  1.  ;           DGVIRI   Veteran Income Relation IEN
  1.  ;           DGVPRI   Veteran Patient Relation IEN
  1.  ;           DGMTNWC  Net Worth Calculation flag
  1.  ; Output -- None
  1.  ;
  1.  ;DG*5.3*540 - Skip displaying of calculated Means Test Status at the
  1.  ;             bottom of screen 4 when in VIEW mode.
  1.  ;DG*5.3*567 - Allow bottom to show for all except SOURCE OF TEST[IVM
  1.  ;             for IVM display Source is IVM instead.
  1.  ;
  1. EN ;Entry point for previous calendar year net worth screen
  1.  S DGMTSCI=4 D HD^DGMTSCU
  1.  D DIS
  1.  S DGRNG="1-5" G EN^DGMTSCR
  1.  ;
  1. EN1 ;Entry point for read processor return
  1.  D ALL^DGMTU21(DFN,"S",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. Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
  1.  G EN
  1.  ;
  1. DIS ;Display net worth
  1.  N DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGTHG,DGVIR0,DGCNT
  1.  D SET^DGMTSCU2 S DGCNT=1
  1.  I DGMTYPT=1 W !,"Income Thresholds:   " W:$D(DGTHA) "MT Threshold: ",$$AMT^DGMTSCU1(DGTHA) W:$D(DGTHG) ?53,"GMT Threshold: ",$$AMT^DGMTSCU1(DGTHG)
  1.  W ! W:$D(DGMTPAR("PREV")) "*Previous Years Thresholds*"
  1.  W ?34,"Veteran" W:DGSP ?46,"Spouse" W ?73,"Total"
  1.  W !?31,"-----------------------------------------------"
  1.  D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN2,1,"Cash, Amts in Bank Accts")
  1.  D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN2,2,"Stocks and Bonds")
  1.  D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN2,3,"Real Property")
  1.  D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN2,4,"Other Property or Assets")
  1.  D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN2,5,"Debts")
  1.  W !?51,"Total -->",?66,$J($$AMT^DGMTSCU1(DGNWT),12)
  1.  I DGMTYPT=1,DGMTACT="VEW",$P($G(DGMT0),"^",14) W !!!!!!!!,"Declines to give income information makes a MT COPAY REQUIRED status." G DISQ
  1.  ;
  1.  ;DG*5.3*540
  1.  ;DG*5.3*567
  1.  I DGMTACT="VEW",DGMTI,$$GET1^DIQ(408.31,DGMTI,.23)["IVM" D  G DISQ
  1.  . W !!!!!!!!,"Source of Test is IVM"
  1.  W !!!!!!!! I DGMTYPT=1 W "Income of ",$J($$AMT^DGMTSCU1(DGINT-DGDET),12) W "  ",$$GETNAME^DGMTH(DGMTS)
  1.  I DGMTYPT=1,DGTYC="M",(DGNWT-DGDET)+$S($G(DGMTNWC):0,1:DGINT)'<$P(DGMTPAR,"^",8) W !,?3,"with property of ",$J($$AMT^DGMTSCU1(DGNWT),12)," makes a ",$S(DGTHG>DGTHA:"G",1:""),"MT COPAY REQUIRED status."
  1.  I DGTYC="M",'DGNWTF W " requires property information."
  1.  I DGMTYPT=2,'DGNWTF,DGCAT="E" W "Requires property information."
  1. DISQ 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.  ;             DGRPCE 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," ",26)=""
  1.  W:DGCNT<10 " "
  1.  W " ",$E(DGTXT_DGBL,1,26)
  1.  W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10)
  1.  W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
  1.  W " ",$S($D(DGIN("D")):$J($$AMT^DGMTSCU1($P(DGIN("D"),"^",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 net worth fields
  1.  N DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR
  1.  D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
  1.  I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
  1.  S DGIN2=$G(^DGMT(408.21,DGINI,2))
  1.  S DA=DGINI,DIE="^DGMT(408.21,",DR="[DGMT ENTER/EDIT NET WORTH]" D ^DIE S:'$D(DGFIN) DGMTOUT=1
  1.  I DGIN2'=$G(^DGMT(408.21,DGINI,2)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
  1. EDTQ Q