source: FOIAVistA/tag/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTCHK.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1EASMTCHK ;ALB/SCK,PJR - MEANS TEST BLOCKING CHECK ; 11/13/03 11:13am
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,15,38,46**;MAR 15,2001
3 ; This routine provides an API, which when called from Appointment Management will allow
4 ; for the blocking of future appointments and appointment check-in/out if the patient
5 ; requires a Means Test or has a Means Test Status of Required. $$LST^DGMTU is used
6 ; to determine if a MT is REQUIRED. If a MT does not have a status of REQUIRED,
7 ; but is more than 365 days out (same criteria used in OLD^DGMTU4), the MT will
8 ; be considered "REQUIRED" for blocking purposes. If a Means Test is required, the
9 ; following combinations of appointment actions will be blocked:
10 ; o Making a future appt for a Regular appt type
11 ; o Check In/Out an appt which is either a Regular or Research type
12 ;
13 ; A Walk-in will see the alert notice, and will be warned NOT to CHECK-IN the walk-in
14 ; appointment. Unscheduled/Walk-ins can ONLY be checked out.
15 ;
16 ; This API may be passed a flag to "silence" the screen display of the alert message, and
17 ; will accept an array variable to return the alert text in. Inpatient appointments
18 ; are not affected in any way. Domicilary are not considered inpatients for the purpose
19 ; of Means Test Blocking for appointments
20 ;
21MT(DFN,EASAPT,EASACT,EASDT,EASQT,EASMSG) ; Entry point for MT Check
22 ; Input Variables
23 ; DFN - Patient's IEN in File #2
24 ; EASAPT - Appointment Type (File #409.1) [Optional]
25 ; EASACT - Appointment Action Flag [Optional] Default = "Other"
26 ; "M" - Make an Appointment
27 ; "C" - Check In/Out an existing appointment
28 ; "W" - Unscheduled/Walk-in appointment
29 ; "O" - Other
30 ; "L" - Letters
31 ;
32 ; EASDT - Appointment Date/Time [Optional]
33 ; EASQT - Silent flag [Optional], if set will prevent display of alert message
34 ; EASMSG - Return array for alert message [Optional], if passed in, the alert
35 ; message text will be copied to this array
36 ;
37 ; Output
38 ; 1 - Block action (MT Required)
39 ; 0 - Don't block action (MT Not required)
40 ;
41 N RSLT,EASMT,EASTXT,EASX,EAMTS,DSPLY,IENS
42 ;
43 S RSLT=0
44 S EASQT=+$G(EASQT)
45 S EASAPT=+$G(EASAPT)
46 S EASDT=$G(EASDT)
47 S EASACT=$G(EASACT)
48 S:EASACT']"" EASACT="O"
49 ; If Appt type is not defined, action is CI/CO, get appt date
50 I 'EASAPT,EASACT="C",EASDT]"" D
51 .N DGARRAY,SDCNT
52 .S DGARRAY(4)=DFN,DGARRAY("SORT")="P",DGARRAY("FLDS")=10
53 .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
54 .S EASAPT=+$P($G(^TMP($J,"SDAMA301",DFN,EASDT)),U,10)
55 .K DGARRAY,SDCNT,^TMP($J,"SDAMA301")
56 ;
57 Q:$$INP(DFN) RSLT ; Quit if inpatient
58 S EAMTS=$$MTCHK(DFN,EASACT) ; Get MT Check flag
59 Q:'EAMTS RSLT
60 ;
61 ;Build Alert message
62 D BLDMSG(EASACT,.EASTXT)
63 I $D(EASMSG) M @EASMSG=EASTXT ; If output array defined,copy message test
64 ;
65 ; Check appointment action and appointment type. Set blocking action
66 I EASACT="M",EASAPT=9 S (DSPLY,RSLT)=1 ; Make an Appt.
67 ;
68 I EASACT="C" D ; Check-in an appt.
69 . I $G(EASAPT)=9 S (DSPLY,RSLT)=1
70 ;
71 I "W,O"[EASACT D ; Walk-in/Other appt.
72 . S:$G(EASAPT)=9 DSPLY=1
73 ;
74 I $G(DSPLY) D
75 . Q:EASQT ; If silent flag is set, do not display alert
76 . S EASX=0
77 . W !?5,$CHAR(7),"******************************************************"
78 . F S EASX=$O(EASTXT(EASX)) Q:'EASX D
79 . . W !?5,EASTXT(EASX)
80 ;
81 ; Check for override key on making appointments
82 I EASACT="M" D
83 . I $D(^XUSEC("EAS MTOVERRIDE",DUZ)) S RSLT=0
84 Q $G(RSLT)
85 ;
86MTCHK(DFN,EASACT) ; Check Means Test Status
87 ; Input
88 ; DFN
89 ;
90 ; Output
91 ; 0 OK
92 ; 1 MEANS TEST Required
93 ;
94 N RSLT,EASTAT,EASDT
95 ;
96 S RSLT=0
97 S EASTAT=$$LST^DGMTU(DFN,"",1)
98 I EASTAT]"" D
99 . I $P(EASTAT,U,4)="R" S RSLT=1 Q
100 . ;; Condition Check: MT Stat="P" AND GMT Threshold>Threshold A
101 . ;; AND MT Date is after 10/5/1999 AND Agrees to pay Deductible
102 . ;; AND MT Date is older than 365 days, THEN MT is required
103 . I $P(EASTAT,U,4)="P",$$GET1^DIQ(408.31,+EASTAT,.27,"I")>$$GET1^DIQ(408.31,+EASTAT,.12,"I"),$P(EASTAT,U,2)>2991005,$$GET1^DIQ(408.31,+EASTAT,.11,"I"),$$OLD^DGMTU4($P(EASTAT,U,2)) S RSLT=1 Q
104 . ;; Condition Check: Cat C or Pending Adj.
105 . ;; AND Agrees to pay Deductible AND MT date after 10/5/1999
106 . I "C,P"[$P(EASTAT,U,4),$$GET1^DIQ(408.31,+EASTAT,.11,"I"),$P(EASTAT,U,2)>2991005 Q
107 . I $P(EASTAT,U,4)="P",$$GET1^DIQ(408.31,+EASTAT,.27,"I")>$$GET1^DIQ(408.31,+EASTAT,.12,"I"),$P(EASTAT,U,2)>2991005,$$GET1^DIQ(408.31,+EASTAT,.11,"I"),$$OLD^DGMTU4($P(EASTAT,U,2)) S RSLT=1 Q
108 . ;; Condition Check: Cat C AND Declines to give income information AND Agreed to pay deductible
109 . I $P(EASTAT,U,4)="C",$$GET1^DIQ(408.31,+EASTAT,.14,"I"),$$GET1^DIQ(408.31,+EASTAT,.11,"I") Q
110 . S EASDT=$P(EASTAT,U,2)
111 . I ($$FMDIFF^XLFDT(DT,EASDT)>365) S RSLT=1
112 . I $G(EASACT)="L" D
113 . . ;; For letters, need to check for letters past 60-day threshold
114 . . I ($$FMDIFF^XLFDT(DT,EASDT)>304) S RSLT=1
115 ;
116 I $P(EASTAT,U,4)="N" S RSLT=0
117 Q $G(RSLT)
118 ;
119BLDMSG(EASACT,EASTXT) ; Build alert message to user
120 N LINE
121 ;
122 S LINE=1
123 S EASTXT(LINE)="Means Test Alert",LINE=LINE+1
124 S EASTXT(LINE)="A Means Test is required or needs to be completed.",LINE=LINE+1
125 ;
126 I "M,C,W"[EASACT D
127 . S EASTXT(LINE)="Please perform MEANS TEST or instruct patient",LINE=LINE+1
128 . S EASTXT(LINE)="to report for Means Test interview.",LINE=LINE+1
129 ;
130 I EASACT="M" D
131 . S EASTXT(LINE)=">> A future appointment cannot be made at this time."
132 . S:$D(^XUSEC("EAS MTOVERRIDE",DUZ)) EASTXT(LINE)=">> Override Key in Effect."
133 . S LINE=LINE+1
134 ;
135 I EASACT="C" S EASTXT(LINE)=">> This action may not be completed at this time.",LINE=LINE+1
136 I EASACT="W" D
137 . S EASTXT(LINE)=">> Check-Out ONLY. Do NOT Check-In (CI) a walk-in appointment",LINE=LINE+1
138 . S EASTXT(LINE)=" You will not be able to check-out the appt. if you do so.",LINE=LINE+1
139 Q
140 ;
141INP(DFN) ; Check on Inpatient status
142 ; Input
143 ; DFN - IEN from patient file
144 ; Output
145 ; 1 - Patient has Inpatient status
146 ; 0 - Patient does not have Inpatient status
147 ; Default
148 ; Inpatient API defaults to TODAY for inpatient status check
149 ;
150 N VAERR,EAIN,VAROOT,VAINDT
151 ;
152 S VAINDT=$$NOW^XLFDT,VAROOT="EAIN"
153 ;; Modified to treat DOM patients as inpatients for the purpose of appointment blocking.
154 ;; EAS*1*12
155 D INP^VADPT
156 Q $S(+$G(EAIN(1)):1,1:0)
Note: See TracBrowser for help on using the repository browser.