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,HM - Means Test Screen Net Worth ;11/7/03 1:44pm
  1. ;;5.3;Registration;**45,130,456,540,567,1014,1064**;Aug 13, 1993;Build 41
  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. ; DGMTACT Global variable, Means test action being perfomed, set when DGMTE, DGMTA, or DGMTEO is called
  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. I DGMTACT'="EDT"&(DGMTACT'="ADD")&(DGMTACT'="COM") D G EN^DGMTSCR ;DG*5.3*1014 check if entry point in screen was from edit, add, or complete a means test and skip screen 4
  1. .D DEP^DGMTSCU2,INC^DGMTSCU3 ;DG*5.3*1014 set variable for screen 4 display
  1. .N DGVET,DGSPD S (DGVET,DGSPD)=""
  1. .S DGVET(1)=$P($G(DGIN2("V")),U),DGVET(2)=$P($G(DGIN2("V")),U,3),DGVET(3)=$P($G(DGIN2("V")),U,4)
  1. .S DGSPD(1)=$P($G(DGIN2("S")),U),DGSPD(2)=$P($G(DGIN2("S")),U,3),DGSPD(3)=$P($G(DGIN2("S")),U,4)
  1. .S DGMTSCI=4 I DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="") D HD^DGMTSCU
  1. .I DGVET(1)=""&(DGVET(2)="")&(DGVET(3)="") S DGSCR1=1
  1. .I DGSPD(1)=""&(DGSPD(2)="")&(DGSPD(3)="") S DGSCR1=1
  1. .I $$GETNAME^DGMTH(DGMTSCI)'="MT COPAY EXEMPT",DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="") D DIS ;DG*5.3*1014 do screen 4 if not MT COPAY EXEMPT
  1. .I $$GETNAME^DGMTH(DGMTSCI)="MT COPAY EXEMPT"&(DGMTACT'="EDT")&(DGMTACT'="ADD")&(DGMTACT'="COM") D ;DG*5.3*1014 do screen 4 if not edit, add, or complete and status is MT COPAY EXEMPT
  1. ..I DGVET(1)'=""!(DGVET(2)'="")!(DGVET(3)'="")!(DGSPD(1)'="")!(DGSPD(2)'="")!(DGSPD(3)'="") D DIS ;if financial data exists for screen 4 display
  1. .S DGRNG="1-3"
  1. .I $G(DGSCR1),DGSCR1=1 D MTMSG ;DG*5.3*1014 display MT status message
  1. I DGMTACT="EDT"!(DGMTACT="ADD")!(DGMTACT="COM") S DGRNG="1-3",DGMTSCI=4 D FEED^DGMTSCR,EN1^DGMTSCR Q ;DG*5.3*1014 do not rewrite bottom of screen
  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. K DGSCR1 ;DG*5.3*1014 kill variable to not display repeating info
  1. MTMSG ;DG*5.3*1014 only display for view a past means test
  1. I DGMTACT="VEW" D
  1. .D DEP^DGMTSCU2,INC^DGMTSCU3
  1. .S DGCAT=$P(^DGMT(408.31,DGMTI,0),"^",3),DGCAT=$P(^DG(408.32,DGCAT,0),"^",2) D STA^DGMTSCU2 S DGCNT=1
  1. .W !!!!!! I DGMTYPT=1 W "Income of ",$J($$AMT^DGMTSCU1(DGINT-DGDET),12) W " ",$$GETNAME^DGMTH(DGMTS)
  1. .;jam; DG*5.3*1064
  1. .I $$INDSTATUS^DGENELA2(DFN) D
  1. . . D BLD^DIALOG(261134,"","","","F")
  1. . . D MSG^DIALOG("WM","","","")
  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