source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDAMA203.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 6.7 KB
Line 
1SDAMA203 ;BPIOFO/ACS-Scheduling API for IMO ;15 April 2003
2 ;;5.3;Scheduling;**285,406**;13 Aug 1993
3 ;
4 ;Scheduling API to return encounter or appointment date/time for
5 ;a patient that can receive inpatient medication from an
6 ;authorized clinic
7 ;
8 ;**********************************************************************
9 ; CHANGE LOG
10 ;
11 ; DATE PATCH DESCRIPTION DEVELOPER
12 ;-------- ---------- ----------------------------------------------
13 ;04/15/03 SD*5.3*285 ROUTINE WRITTEN A SAUNDERS
14 ;10/12/06 SD*5.3*406 FIXED ERROR CODE -3 A SAUNDERS
15 ;
16 ;**********************************************************************
17 ;
18 ; **** TO BE CALLED WITH AN EXTRINISIC CALL ****
19 ;Example: I $$SDIMO^SDAMA203(CLIEN,DFN) S APPTDT=SDIMO(1) K SDIMO(1)
20 ;
21 ;INPUT
22 ; SDCLIEN Clinic IEN (required)
23 ; SDPATDFN Patient DFN (required)
24 ;
25 ;OUTPUT
26 ; The extrinsic call will return one of the following values:
27 ; 1 Patient has at least one scheduled appointment or checked-in
28 ; visit in an authorized clinic
29 ; 0 Patient has no scheduled appointments or checked-in visits
30 ; in an authorized clinic
31 ; -1 Clinic is not an authorized clinic, clinic is inactive,
32 ; or SDCLIEN is null
33 ; -2 SDPATDFN is null
34 ; -3 Scheduling database is unavailable
35 ;
36 ; If a 1 is returned, then SDIMO(1) = Encounter or appointment
37 ; date/time in FileMan format
38 ;
39 ;**********************************************************************
40 ; Special Logic:
41 ; - In line tag SDVISIT, the ACRP Toolkit API EXOE^SDOE is called
42 ; multiple times as needed. This API returns the NEXT encounter,
43 ; given a start and end date/time. We want to check ALL encounters
44 ; for a match on clinic IEN
45 ; - In line tag SDDATE, if the current time is between midnight and 6am,
46 ; the API will start to look for encounters and/or appointments on the
47 ; previous day
48 ;
49 ; Internal variables:
50 ; SDBACK Contains the value to be returned from this call. See
51 ; above for OUTPUT values and corresponding definitions
52 ; SDCONT Flag to indicate if processing should continue. If
53 ; the patient has an encounter in an authorized clinic
54 ; today, then we can skip the last step and not look for
55 ; a scheduled appointment
56 ; SDFROM The date to start searching for an encounter or appointment
57 ; SDAPPTDT Encounter or appointment date/time returned in SDIMO(1)
58 ;
59 ;**********************************************************************
60SDIMO(SDCLIEN,SDPATDFN) ;
61 ;
62 ;--INITIALIZATION--
63 K SDIMO(1)
64 N SDBACK,SDCONT,SDFROM,SDAPPTDT
65 S SDBACK=1,SDCONT=1,SDAPPTDT=0,SDFROM=0
66 ;
67 ;--MAIN--
68 ; Valid variables passed in?
69 D SDVALVAR($G(SDPATDFN),$G(SDCLIEN),.SDBACK)
70 ; If no error, is clinic active and authorized?
71 I SDBACK=1 D SDAUTHCL(SDCLIEN,.SDBACK)
72 ; If no error, set up search "start" date
73 I SDBACK=1 D SDDATE(.SDFROM)
74 ; If no error, does patient have an encounter in that clinic?
75 I SDBACK=1 D SDVISIT(SDPATDFN,SDCLIEN,.SDAPPTDT,.SDCONT,.SDBACK,SDFROM)
76 ; If no error and no encounter, does patient have an appointment in that
77 ; clinic?
78 I SDBACK=1,SDCONT=1 D SDAPPT(SDPATDFN,SDCLIEN,.SDAPPTDT,.SDBACK,SDFROM)
79 ;
80 ;--FINALIZATION--
81 ; If no error
82 I SDBACK=1 D
83 . ; Set up output array with the encounter or appointment date/time
84 . ; Make sure the appointment date/time exists in SDAPPTDT
85 . I $G(SDAPPTDT)]"" D
86 .. S SDIMO(1)=SDAPPTDT
87 . I $G(SDAPPTDT)']"" D
88 .. S SDBACK=0
89 ; Return value
90 Q SDBACK
91 ;
92 ;----------------------------------------------------------------------
93 ;-Validate input variables
94SDVALVAR(SDPATDFN,SDCLIEN,SDBACK) ;
95 ; Clinic IEN and patient DFN cannot be null
96 I $G(SDCLIEN)="" S SDBACK=-1 Q
97 I $G(SDPATDFN)="" S SDBACK=-2 Q
98 Q
99 ;
100 ;-Clinic must be type "C", authorized to administer inpatient meds,
101 ;-and active
102SDAUTHCL(SDCLIEN,SDBACK) ;
103 N SDAUTH,SDTYPE
104 S SDAUTH=0,SDTYPE=0
105 ; clinic must be type "C"
106 S SDTYPE=$P($G(^SC(SDCLIEN,0)),"^",3)
107 I $G(SDTYPE)="C" D
108 . ; clinic must be authorized to administer inpatient meds
109 . I $D(^SC("AE",1,SDCLIEN)) S SDAUTH=1
110 I SDAUTH'=1 S SDBACK=-1 Q
111 ; clinic must be active
112 ; if clinic inactivate date exists, check further
113 N SDINACT,SDREACT
114 S SDINACT=$P($G(^SC(SDCLIEN,"I")),"^",1)
115 I $G(SDINACT)]"" D
116 . ; if inactivate date is today or earlier, get reactivate date
117 . I SDINACT'>DT D
118 .. S SDREACT=$P($G(^SC(SDCLIEN,"I")),"^",2)
119 .. ; reactivate date can't be null
120 .. I $G(SDREACT)="" S SDBACK=-1
121 .. ; if reactivate date exists
122 .. E D
123 ... ; reactivate date must be less than or equal to today
124 ... ; but greater than or equal to inactivate date
125 ... I (SDREACT>DT!(SDREACT<SDINACT)) S SDBACK=-1
126 Q
127 ;-Set up start date for encounters and appointments
128SDDATE(SDFROM) ;
129 N %,X
130 D NOW^%DTC
131 ;if the current time is before 6am, set 'start' date to yesterday
132 I ("."_$P(%,".",2))<.060000 S SDFROM=(X-1)
133 E S SDFROM=X
134 Q
135 ;-Look for encounter that occurred in the authorized clinic
136SDVISIT(SDPATDFN,SDCLIEN,SDAPPTDT,SDCONT,SDBACK,SDFROM) ;
137 N SDSTART,SDEND,SDENCNUM,SDENCDT,SDENCCL
138 ; set up start and end date/time
139 S SDSTART=SDFROM_".0000"
140 S SDEND=DT_".2359"
141 ; get encounters
142 F D Q:+SDENCNUM=0
143 . ; call API to get next encounter
144 . S SDENCNUM=+$$EXOE^SDOE(SDPATDFN,SDSTART,SDEND)
145 . I $G(SDENCNUM) D
146 .. ; encounter found. call API to get more encounter data
147 .. D GETGEN^SDOE(SDENCNUM,"SDDATA")
148 .. I $G(SDDATA(0)) D
149 ... ; get encounter date/time and clinic IEN
150 ... S SDENCDT=$P($G(SDDATA(0)),"^",1),SDENCCL=$P($G(SDDATA(0)),"^",4)
151 ... ; if encounter clinic matches authorized clinic, set flags
152 ... I $G(SDENCCL)=SDCLIEN S SDENCNUM=0,SDCONT=0,SDAPPTDT=$G(SDENCDT)
153 ... ; if no match on clinic, reset start date for next encounter
154 ... I $G(SDENCCL)'=SDCLIEN S SDSTART=(SDENCDT+.000001)
155 ... K SDDATA
156 Q
157 ;-Look for scheduled appointment in the authorized clinic
158SDAPPT(SDPATDFN,SDCLIEN,SDAPPTDT,SDBACK,SDFROM) ;
159 N SDRESULT,SDAPPTCL,SDMATCH
160 S SDMATCH=0
161 ; call API to get appointments for this patient
162 D GETAPPT^SDAMA201(SDPATDFN,"1;2","R;NT",SDFROM,,.SDRESULT)
163 ; SDRESULT contains a count of the returned appointments
164 I SDRESULT>0 D
165 . N SDI
166 . ; spin through returned appointments and look for match on clinic IEN
167 . F SDI=1:1:SDRESULT D Q:SDMATCH=1
168 .. S SDAPPTCL=$G(^TMP($J,"SDAMA201","GETAPPT",SDI,2))
169 .. I +$G(SDAPPTCL)=SDCLIEN D
170 ... S SDAPPTDT=$G(^TMP($J,"SDAMA201","GETAPPT",SDI,1))
171 ... S SDMATCH=1
172 . ; delete appointment array returned from Scheduling API
173 . K ^TMP($J,"SDAMA201","GETAPPT")
174 I ((SDRESULT=0)!(SDMATCH=0)) S SDBACK=0
175 I SDRESULT=-1 D
176 . S SDBACK=0
177 . ; if database unavailable, set database-specific flag
178 . I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR",101)) S SDBACK=-3
179 . ; delete error array returned from Scheduling API
180 . K ^TMP($J,"SDAMA201","GETAPPT")
181 Q
Note: See TracBrowser for help on using the repository browser.