| [613] | 1 | DGMTSCU ;ALB/RMO/CAW,LBD - Means Test Screen Driver Utilities ;21 JAN 1992 8:00 pm
|
|---|
| 2 | ;;5.3;Registration;**456**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | SETUP ;Set-up the screen driver array and required screen variables
|
|---|
| 5 | ; Input -- DFN Patient IEN
|
|---|
| 6 | ; DGMTDT Date of Test
|
|---|
| 7 | ; DGMTYPT Type of Test
|
|---|
| 8 | ; Output -- DGMTSC Screen Driver Array
|
|---|
| 9 | ; DGVPRI Veteran Patient Relation IEN
|
|---|
| 10 | ; DGVINI Veteran Individual Annual Income IEN
|
|---|
| 11 | ; DGVIRI Veteran Income Relation IEN
|
|---|
| 12 | ; DGMTPAR Annual Means Test Parameter Array
|
|---|
| 13 | ; DGMTGMT GMT Threshold Values
|
|---|
| 14 | ; DGMTNWC Net Worth Calculation flag
|
|---|
| 15 | ; DGERR 1=ERROR and 0=NO ERROR
|
|---|
| 16 | N DGINI,DGIRI,DGLY,DGPRI,DGPRTY,DGSCR,I,X
|
|---|
| 17 | K DGMTSC S DGERR=0,DGLY=$$LYR^DGMTSCU1(DGMTDT)
|
|---|
| 18 | S DGSCR=$S(DGMTYPT=1:5,DGMTYPT=2&($$ASKNW^DGMTCOU):5,1:4)
|
|---|
| 19 | F I=1:1 S X=$P($T(SCRNS+I),";;",2) Q:X="QUIT"!(+X=DGSCR) S DGMTSC(+X)=X
|
|---|
| 20 | D NEW^DGRPEIS1 S:DGPRI'>0 DGERR=1 G Q:DGERR S DGVPRI=DGPRI
|
|---|
| 21 | D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G Q:DGERR S DGVINI=DGINI,DGVIRI=DGIRI
|
|---|
| 22 | D PAR S:DGMTPAR="" DGERR=1
|
|---|
| 23 | Q Q
|
|---|
| 24 | ;
|
|---|
| 25 | PAR ;Annual Means Test Parameters
|
|---|
| 26 | ; Input -- DGLY Last Year
|
|---|
| 27 | ; Output -- DGMTPAR Means Test Parameter 0th node
|
|---|
| 28 | ; DGMTGMT GMT Threshold values
|
|---|
| 29 | ; DGMTNWC Net Worth Calculation flag
|
|---|
| 30 | ; Returned if the current year's parameters are not available:
|
|---|
| 31 | ; DGMTPAR("PREV") Previous Year Income Parameters
|
|---|
| 32 | N GMT
|
|---|
| 33 | S DGMTPAR=$S($D(^DG(43,1,"MT",DGLY+10000,0)):^(0),1:"")
|
|---|
| 34 | I DGMTPAR']"",$D(^DG(43,1,"MT",DGLY,0)) S DGMTPAR=^(0),DGMTPAR("PREV")=""
|
|---|
| 35 | ; Get Net Worth Calculation flag
|
|---|
| 36 | S DGMTNWC=+$G(^DG(43,1,"GMT"))
|
|---|
| 37 | ; Get GMT Threshold values for this veteran
|
|---|
| 38 | S DGMTGMT=""
|
|---|
| 39 | D GETFIPS^EASAILK(DFN,DGLY,.GMT)
|
|---|
| 40 | I '$G(GMT("GMTIEN")) Q
|
|---|
| 41 | S DGMTGMT=$G(^EAS(712.5,GMT("GMTIEN"),1))
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | HD ;Print screen header
|
|---|
| 45 | ; Input -- DGMTSCI Screen number
|
|---|
| 46 | ; DGVPRI Veteran Patient Relation IEN
|
|---|
| 47 | ; DGMTDT Date of Test
|
|---|
| 48 | ; DGHLPF Help Flag (Optional)
|
|---|
| 49 | ; Output -- Screen Header
|
|---|
| 50 | N DGHDR,DGIOM,DGLNE,DGMTSCR,DGTAB,Y
|
|---|
| 51 | S:'$D(DGHLPF) DGHLPF=0
|
|---|
| 52 | S DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))=""
|
|---|
| 53 | S DGHDR=$P($$SCR(DGMTSCI),";",2)_", SCREEN <"_+$$SCR(DGMTSCI)_"> "_$S(DGHLPF:"HELP",1:"")
|
|---|
| 54 | S DGTAB=DGIOM-$L(DGHDR)\2
|
|---|
| 55 | 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
|
|---|
| 56 | S X="IOINHI;IOINLOW" D ENDR^%ZISS K X S DGVI=IOINHI,DGVO=IOINLOW S X=132 X ^%ZOSF("RM")
|
|---|
| 57 | HDNH ;
|
|---|
| 58 | W @IOF W ?DGTAB,DGVI,DGHDR,DGVO
|
|---|
| 59 | I 'DGHLPF W !,$$NAME^DGMTU1(DGVPRI)," ",$$SSN^DGMTU1(DGVPRI),?(DGIOM-24),"ANNUAL INCOME FOR " S Y=$$LYR^DGMTSCU1(DGMTDT) X ^DD("DD") W Y
|
|---|
| 60 | W !,DGLNE
|
|---|
| 61 | K DGHLPF Q
|
|---|
| 62 | ;
|
|---|
| 63 | SCR(DGMTSCI) ;Screen name and number
|
|---|
| 64 | ; Input -- DGMTSCI Screen number
|
|---|
| 65 | ; Output -- Screen number;Screen name
|
|---|
| 66 | N DGMTSCR
|
|---|
| 67 | S DGMTSCR=$P($G(DGMTSC(DGMTSCI)),";",1,2)
|
|---|
| 68 | Q $G(DGMTSCR)
|
|---|
| 69 | ;
|
|---|
| 70 | ROU(DGMTSCI) ;Screen entry routine
|
|---|
| 71 | ; Input -- DGMTSCI Screen number
|
|---|
| 72 | ; Output -- Routine name
|
|---|
| 73 | N DGROU
|
|---|
| 74 | S DGROU=$P($G(DGMTSC(DGMTSCI)),";",3)
|
|---|
| 75 | Q $G(DGROU)
|
|---|
| 76 | ;
|
|---|
| 77 | ROURET(DGMTSCI) ;Screen read processor return routine
|
|---|
| 78 | ; Input -- DGMTSCI Screen number
|
|---|
| 79 | ; Output -- Routine name
|
|---|
| 80 | N DGROU
|
|---|
| 81 | S DGROU=$P($G(DGMTSC(DGMTSCI)),";",4)
|
|---|
| 82 | Q $G(DGROU)
|
|---|
| 83 | ;
|
|---|
| 84 | SCRNS ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
|
|---|
| 85 | ;;1;MARITAL STATUS/DEPENDENTS;EN^DGMTSC1;EN1^DGMTSC1
|
|---|
| 86 | ;;2;PREVIOUS CALENDAR YEAR GROSS INCOME;EN^DGMTSC2;EN1^DGMTSC2
|
|---|
| 87 | ;;3;DEDUCTIBLE EXPENSES;EN^DGMTSC3;EN1^DGMTSC3
|
|---|
| 88 | ;;4;PREVIOUS CALENDAR YEAR NET WORTH;EN^DGMTSC4;EN1^DGMTSC4
|
|---|
| 89 | ;;QUIT
|
|---|
