source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTSCU.m@ 1096

Last change on this file since 1096 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1DGMTSCU ;ALB/RMO/CAW,LBD - Means Test Screen Driver Utilities ;21 JAN 1992 8:00 pm
2 ;;5.3;Registration;**456**;Aug 13, 1993
3 ;
4SETUP ;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
23Q Q
24 ;
25PAR ;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 ;
44HD ;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")
57HDNH ;
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 ;
63SCR(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 ;
70ROU(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 ;
77ROURET(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 ;
84SCRNS ;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
Note: See TracBrowser for help on using the repository browser.