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

DGMTSCU.m

Go to the documentation of this file.
  1. DGMTSCU ;ALB/RMO/CAW,LBD - Means Test Screen Driver Utilities ;21 JAN 1992 8:00 pm
  1. ;;5.3;Registration;**456,688**;Aug 13, 1993;Build 29
  1. ;
  1. SETUP ;Set-up the screen driver array and required screen variables
  1. ; Input -- DFN Patient IEN
  1. ; DGMTDT Date of Test
  1. ; DGMTYPT Type of Test
  1. ; Output -- DGMTSC Screen Driver Array
  1. ; DGVPRI Veteran Patient Relation IEN
  1. ; DGVINI Veteran Individual Annual Income IEN
  1. ; DGVIRI Veteran Income Relation IEN
  1. ; DGMTPAR Annual Means Test Parameter Array
  1. ; DGMTGMT GMT Threshold Values
  1. ; DGMTNWC Net Worth Calculation flag
  1. ; DGERR 1=ERROR and 0=NO ERROR
  1. N DGINI,DGIRI,DGLY,DGPRI,DGPRTY,DGSCR,I,X
  1. K DGMTSC S DGERR=0,DGLY=$$LYR^DGMTSCU1(DGMTDT)
  1. S DGSCR=$S(DGMTYPT=1:5,DGMTYPT=2&($$ASKNW^DGMTCOU):5,1:4)
  1. ;
  1. ;* Check version; IF pre 2005 form, call version 0 input
  1. I (+$P($G(^DGMT(408.31,DGMTI,2)),"^",11)=0) DO
  1. . F I=1:1 S X=$P($T(SCRNS+I),";;",2) Q:X="QUIT"!(+X=DGSCR) S DGMTSC(+X)=X
  1. ;* Check version; IF Feb-2005 form, call version 1 input
  1. I (+$P($G(^DGMT(408.31,DGMTI,2)),"^",11)=1) DO
  1. . F I=1:1 S X=$P($T(SCRNS1+I),";;",2) Q:X="QUIT"!(+X=DGSCR) S DGMTSC(+X)=X
  1. ;
  1. D NEW^DGRPEIS1 S:DGPRI'>0 DGERR=1 G Q:DGERR S DGVPRI=DGPRI
  1. D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G Q:DGERR S DGVINI=DGINI,DGVIRI=DGIRI
  1. D PAR S:DGMTPAR="" DGERR=1
  1. Q Q
  1. ;
  1. PAR ;Annual Means Test Parameters
  1. ; Input -- DGLY Last Year
  1. ; Output -- DGMTPAR Means Test Parameter 0th node
  1. ; DGMTGMT GMT Threshold values
  1. ; DGMTNWC Net Worth Calculation flag
  1. ; Returned if the current year's parameters are not available:
  1. ; DGMTPAR("PREV") Previous Year Income Parameters
  1. N GMT
  1. S DGMTPAR=$S($D(^DG(43,1,"MT",DGLY+10000,0)):^(0),1:"")
  1. I DGMTPAR']"",$D(^DG(43,1,"MT",DGLY,0)) S DGMTPAR=^(0),DGMTPAR("PREV")=""
  1. ; Get Net Worth Calculation flag
  1. S DGMTNWC=+$G(^DG(43,1,"GMT"))
  1. ; Get GMT Threshold values for this veteran
  1. S DGMTGMT=""
  1. D GETFIPS^EASAILK(DFN,DGLY,.GMT)
  1. I '$G(GMT("GMTIEN")) Q
  1. S DGMTGMT=$G(^EAS(712.5,GMT("GMTIEN"),1))
  1. Q
  1. ;
  1. HD ;Print screen header
  1. ; Input -- DGMTSCI Screen number
  1. ; DGVPRI Veteran Patient Relation IEN
  1. ; DGMTDT Date of Test
  1. ; DGHLPF Help Flag (Optional)
  1. ; Output -- Screen Header
  1. N DGHDR,DGIOM,DGLNE,DGMTSCR,DGTAB,Y
  1. S:'$D(DGHLPF) DGHLPF=0
  1. S DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))=""
  1. S DGHDR=$P($$SCR(DGMTSCI),";",2)_", SCREEN <"_+$$SCR(DGMTSCI)_"> "_$S(DGHLPF:"HELP",1:"")
  1. S DGTAB=DGIOM-$L(DGHDR)\2
  1. S (DGVI,DGVO)="" I $S('$D(IOST(0)):1,'$D(^DG(43,1,0)):1,'$P(^DG(43,1,0),"^",36):1,$D(^DG(43,1,"TERM",IOST(0))):1,1:0) G HDNH ;goto HDNH if not high intensity
  1. S X="IOINHI;IOINLOW" D ENDR^%ZISS K X S DGVI=IOINHI,DGVO=IOINLOW S X=132 X ^%ZOSF("RM")
  1. HDNH ;
  1. W @IOF W ?DGTAB,DGVI,DGHDR,DGVO
  1. I 'DGHLPF W !,$$NAME^DGMTU1(DGVPRI)," ",$$SSN^DGMTU1(DGVPRI),?(DGIOM-24),"ANNUAL INCOME FOR " S Y=$$LYR^DGMTSCU1(DGMTDT) X ^DD("DD") W Y
  1. W !,DGLNE
  1. K DGHLPF Q
  1. ;
  1. SCR(DGMTSCI) ;Screen name and number
  1. ; Input -- DGMTSCI Screen number
  1. ; Output -- Screen number;Screen name
  1. N DGMTSCR
  1. S DGMTSCR=$P($G(DGMTSC(DGMTSCI)),";",1,2)
  1. Q $G(DGMTSCR)
  1. ;
  1. ROU(DGMTSCI) ;Screen entry routine
  1. ; Input -- DGMTSCI Screen number
  1. ; Output -- Routine name
  1. N DGROU
  1. S DGROU=$P($G(DGMTSC(DGMTSCI)),";",3)
  1. Q $G(DGROU)
  1. ;
  1. ROURET(DGMTSCI) ;Screen read processor return routine
  1. ; Input -- DGMTSCI Screen number
  1. ; Output -- Routine name
  1. N DGROU
  1. S DGROU=$P($G(DGMTSC(DGMTSCI)),";",4)
  1. Q $G(DGROU)
  1. ;
  1. ;Version 0 screen processing
  1. SCRNS ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
  1. ;;1;MARITAL STATUS/DEPENDENTS;EN^DGMTSC1;EN1^DGMTSC1
  1. ;;2;PREVIOUS CALENDAR YEAR GROSS INCOME;EN^DGMTSC2;EN1^DGMTSC2
  1. ;;3;DEDUCTIBLE EXPENSES;EN^DGMTSC3;EN1^DGMTSC3
  1. ;;4;PREVIOUS CALENDAR YEAR NET WORTH;EN^DGMTSC4;EN1^DGMTSC4
  1. ;;QUIT
  1. ;
  1. ;Version 1 screen processing
  1. SCRNS1 ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
  1. ;;1;MARITAL STATUS/DEPENDENTS;EN^DGMTSC1;EN1^DGMTSC1
  1. ;;2;PREVIOUS CALENDAR YEAR GROSS INCOME;EN^DGMTSC2V;EN1^DGMTSC2V
  1. ;;3;DEDUCTIBLE EXPENSES;EN^DGMTSC3V;EN1^DGMTSC3V
  1. ;;4;PREVIOUS CALENDAR YEAR NET WORTH;EN^DGMTSC4V;EN1^DGMTSC4V
  1. ;;QUIT