1 | EASECSCU ;ALB/LBD - LTC Co-Pay Test Screen Driver Utilities ;10 AUG 2001
|
---|
2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,40**;Mar 15, 2001
|
---|
3 | ;
|
---|
4 | ;NOTE: This routine was modified from DGMTSCU for LTC Co-pay
|
---|
5 | SETUP ;Set-up the screen driver array and required screen variables
|
---|
6 | ; Input -- DFN Patient IEN
|
---|
7 | ; DGMTDT Date of Test
|
---|
8 | ; DGMTYPT Type of Test
|
---|
9 | ; Output -- DGMTSC Screen Driver Array
|
---|
10 | ; DGVPRI Veteran Patient Relation IEN
|
---|
11 | ; DGVINI Veteran Individual Annual Income IEN
|
---|
12 | ; DGVIRI Veteran Income Relation IEN
|
---|
13 | ; DGMTPAR Annual Means Test Parameter Array
|
---|
14 | ; DGFORM 10-10EC Form (1=Revised; 0=Original)
|
---|
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 | F I=1:1 S X=$P($T(SCRNS+I),";;",2) Q:X="QUIT" S DGMTSC(+X)=X
|
---|
19 | D NEW^EASECED1 S:DGPRI'>0 DGERR=1 G Q:DGERR S DGVPRI=DGPRI
|
---|
20 | D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) G Q:DGERR S DGVINI=DGINI,DGVIRI=DGIRI
|
---|
21 | D PAR S:DGMTPAR="" DGERR=1
|
---|
22 | ; Set DGFORM to indicate which 10-10EC form was used to complete
|
---|
23 | ; the LTC copay test. If DGFORM=1 the revised format will be used
|
---|
24 | ; for the LTC copay test screens, otherwise the original format is
|
---|
25 | ; used. Added for LTC IV (EAS*1*40).
|
---|
26 | S DGFORM=$$FORM^EASECU($G(DGMTI))
|
---|
27 | Q Q
|
---|
28 | ;
|
---|
29 | PAR ;Annual Means Test Parameters
|
---|
30 | ; Input -- DGLY Last Year
|
---|
31 | ; Output -- DGMTPAR Means Test Parameter 0th node
|
---|
32 | ; Returned if the current year's parameters are not available:
|
---|
33 | ; DGMTPAR("PREV") Previous Year Income Parameters
|
---|
34 | S DGMTPAR=$S($D(^DG(43,1,"MT",DGLY+10000,0)):^(0),1:"")
|
---|
35 | I DGMTPAR']"",$D(^DG(43,1,"MT",DGLY,0)) S DGMTPAR=^(0),DGMTPAR("PREV")=""
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | HD ;Print screen header
|
---|
39 | ; Input -- DGMTSCI Screen number
|
---|
40 | ; DGVPRI Veteran Patient Relation IEN
|
---|
41 | ; DGMTDT Date of Test
|
---|
42 | ; DGHLPF Help Flag (Optional)
|
---|
43 | ; Output -- Screen Header
|
---|
44 | N DGHDR,DGIOM,DGLNE,DGMTSCR,DGTAB,Y,IOINHI,IOINLOW
|
---|
45 | S:'$D(DGHLPF) DGHLPF=0
|
---|
46 | S DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))=""
|
---|
47 | S DGHDR=$P($$SCR(DGMTSCI),";",2)_", SCREEN <"_+$$SCR(DGMTSCI)_"> "_$S(DGHLPF:"HELP",1:"")
|
---|
48 | S DGTAB=DGIOM-$L(DGHDR)\2
|
---|
49 | 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
|
---|
50 | S X="IOINHI;IOINLOW" D ENDR^%ZISS K X S DGVI=IOINHI,DGVO=IOINLOW S X=132 X ^%ZOSF("RM")
|
---|
51 | HDNH ;
|
---|
52 | W @IOF W ?DGTAB,DGVI,DGHDR,DGVO
|
---|
53 | I 'DGHLPF W !,$$NAME^DGMTU1(DGVPRI)," ",$$SSN^DGMTU1(DGVPRI),?(DGIOM-26),"LTC COPAY TEST FOR " S Y=$E(DGMTDT,1,3)_"0000" X ^DD("DD") W Y
|
---|
54 | W !,DGLNE
|
---|
55 | K DGHLPF Q
|
---|
56 | ;
|
---|
57 | SCR(DGMTSCI) ;Screen name and number
|
---|
58 | ; Input -- DGMTSCI Screen number
|
---|
59 | ; Output -- Screen number;Screen name
|
---|
60 | N DGMTSCR
|
---|
61 | S DGMTSCR=$P($G(DGMTSC(DGMTSCI)),";",1,2)
|
---|
62 | Q $G(DGMTSCR)
|
---|
63 | ;
|
---|
64 | ROU(DGMTSCI) ;Screen entry routine
|
---|
65 | ; Input -- DGMTSCI Screen number
|
---|
66 | ; Output -- Routine name
|
---|
67 | N DGROU
|
---|
68 | S DGROU=$P($G(DGMTSC(DGMTSCI)),";",3)
|
---|
69 | Q $G(DGROU)
|
---|
70 | ;
|
---|
71 | ROURET(DGMTSCI) ;Screen read processor return routine
|
---|
72 | ; Input -- DGMTSCI Screen number
|
---|
73 | ; Output -- Routine name
|
---|
74 | N DGROU
|
---|
75 | S DGROU=$P($G(DGMTSC(DGMTSCI)),";",4)
|
---|
76 | Q $G(DGROU)
|
---|
77 | ;
|
---|
78 | SCRNS ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
|
---|
79 | ;;1;MILITARY SERVICE DATA;EN^EASECSC1;EN1^EASECSC1
|
---|
80 | ;;2;INSURANCE DATA;EN^EASECSC2;EN1^EASECSC2
|
---|
81 | ;;3;MARITAL STATUS/DEPENDENTS;EN^EASECSC3;EN1^EASECSC3
|
---|
82 | ;;4;FIXED AND LIQUID ASSETS;EN^EASECSC4;EN1^EASECSC4
|
---|
83 | ;;5;CURRENT CALENDAR YEAR GROSS INCOME;EN^EASECSC5;EN1^EASECSC5
|
---|
84 | ;;6;DEDUCTIBLE EXPENSES;EN^EASECSC6;EN1^EASECSC6
|
---|
85 | ;;QUIT
|
---|