Changeset 968
- Timestamp:
- Sep 29, 2010, 3:48:57 AM (14 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 37 edited
-
BSDX01.m (modified) (7 diffs)
-
BSDX02.m (modified) (1 diff)
-
BSDX03.m (modified) (1 diff)
-
BSDX04.m (modified) (1 diff)
-
BSDX05.m (modified) (1 diff)
-
BSDX06.m (modified) (1 diff)
-
BSDX07.m (modified) (1 diff)
-
BSDX08.m (modified) (1 diff)
-
BSDX09.m (modified) (1 diff)
-
BSDX11.m (modified) (1 diff)
-
BSDX12.m (modified) (1 diff)
-
BSDX13.m (modified) (1 diff)
-
BSDX14.m (modified) (1 diff)
-
BSDX15.m (modified) (1 diff)
-
BSDX16.m (modified) (1 diff)
-
BSDX17.m (modified) (1 diff)
-
BSDX18.m (modified) (1 diff)
-
BSDX19.m (modified) (1 diff)
-
BSDX20.m (modified) (1 diff)
-
BSDX21.m (modified) (1 diff)
-
BSDX22.m (modified) (1 diff)
-
BSDX23.m (modified) (1 diff)
-
BSDX24.m (modified) (1 diff)
-
BSDX25.m (modified) (1 diff)
-
BSDX26.m (modified) (1 diff)
-
BSDX27.m (modified) (1 diff)
-
BSDX28.m (modified) (1 diff)
-
BSDX29.m (modified) (1 diff)
-
BSDX2E.m (modified) (1 diff)
-
BSDX30.m (modified) (1 diff)
-
BSDX31.m (modified) (1 diff)
-
BSDX32.m (modified) (3 diffs)
-
BSDX33.m (modified) (1 diff)
-
BSDX34.m (modified) (1 diff)
-
BSDX35.m (modified) (1 diff)
-
BSDXAPI.m (modified) (1 diff)
-
BSDXGPRV.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX01.m
r965 r968 1 1 BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:20am 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point … … 38 38 ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!) 39 39 ;If BSDXDUZ=0 then returns all department names for current DUZ 40 40 ;if not linked, always returned. 41 41 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE 42 42 ;then ALL resource group names are returned regardless of whether any active resources … … 61 61 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U) 62 62 . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file) 63 63 . ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit 64 64 . S BSDXRNOD=^BSDXRES(BSDXRES,0) 65 65 . ;QUIT if the resource is inactive … … 120 120 . S BSDXRNOD=^BSDXRES(BSDXRES,0) 121 121 . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location 122 122 . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered 123 123 . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4) 124 124 . ;I '$$INDIV(BSDXSC) QUIT ; If not in division, quit 125 125 . K BSDXRDAT 126 126 . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX) 127 127 . S BSDXRDAT=BSDXRES_U_BSDXRDAT … … 198 198 . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U) 199 199 . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group 200 200 . ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user. 201 201 . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0)) 202 202 . Q:BSDXRNOD="" … … 223 223 . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^") 224 224 . . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid 225 225 . . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division 226 226 . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) 227 227 . . Q:BSDXRNOD="" … … 257 257 I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0 258 258 Q 1 259 INDIV(BSDXSC) 260 261 262 263 264 265 266 267 268 269 270 271 INDIV2(BSDXRES) 272 273 274 275 UnitTestINDIV 276 277 278 279 280 281 282 283 284 285 286 287 288 289 UnitTestINDIV2 290 291 292 293 294 295 296 259 INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user? 260 ; Input: BSDXSC - Hospital Location IEN 261 ; Output: True or False 262 I '+BSDXSC QUIT 1 ;If not tied to clinic, yes 263 I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes 264 ; Jump to Division:Medical Center Division:Inst File Pointer for 265 ; Institution IEN (and get its internal value) 266 N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I") 267 I DIV="" Q 1 ; If clinic has no division, consider it avial to user. 268 I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic 269 E Q 0 ; Otherwise, no 270 QUIT 271 INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user? 272 ; Input BSDXRES - BSDX RESOURCE IEN 273 ; Output: True of False 274 Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV 275 UnitTestINDIV 276 W "Testing if they are the same",! 277 S DUZ(2)=67 278 I '$$INDIV(1) W "ERROR",! 279 I '$$INDIV(2) W "ERROR",! 280 W "Testing if Div not defined in 44, should be true",! 281 I '$$INDIV(3) W "ERROR",! 282 W "Testing empty string. Should be true",! 283 I '$$INDIV("") W "ERROR",! 284 W "Testing if they are different",! 285 S DUZ(2)=899 286 I $$INDIV(1) W "ERROR",! 287 I $$INDIV(2) W "ERROR",! 288 QUIT 289 UnitTestINDIV2 290 W "Testing if they are the same",! 291 S DUZ(2)=69 292 I $$INDIV2(22)'=0 W "ERROR",! 293 I $$INDIV2(25)'=1 W "ERROR",! 294 I $$INDIV2(26)'=1 W "ERROR",! 295 I $$INDIV2(27)'=1 W "ERROR",! 296 QUIT -
Scheduling/trunk/m/BSDX02.m
r951 r968 1 1 BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log -
Scheduling/trunk/m/BSDX03.m
r951 r968 1 1 BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX04.m
r951 r968 1 1 BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; Change Log: 4 4 ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates -
Scheduling/trunk/m/BSDX05.m
r951 r968 1 1 BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX06.m
r951 r968 1 1 BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; Change Log: 4 4 ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get -
Scheduling/trunk/m/BSDX07.m
r951 r968 1 1 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:11pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX08.m
r951 r968 1 1 BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/15/10 8:21pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX09.m
r951 r968 1 1 BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 8/16/10 4:28pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX11.m
r951 r968 1 1 BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ENV0100 ;EP Version 1.0 Environment check -
Scheduling/trunk/m/BSDX12.m
r951 r968 1 1 BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX13.m
r951 r968 1 1 BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX14.m
r951 r968 1 1 BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX15.m
r951 r968 1 1 BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX16.m
r951 r968 1 1 BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX17.m
r951 r968 1 1 BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX18.m
r951 r968 1 1 BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX19.m
r951 r968 1 1 BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX20.m
r951 r968 1 1 BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX21.m
r951 r968 1 1 BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX22.m
r951 r968 1 1 BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX23.m
r951 r968 1 1 BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX24.m
r951 r968 1 1 BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX25.m
r951 r968 1 1 BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX26.m
r951 r968 1 1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX27.m
r951 r968 1 1 BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: July 15, 2010 -
Scheduling/trunk/m/BSDX28.m
r951 r968 1 1 BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX29.m
r951 r968 1 1 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX2E.m
r951 r968 1 1 BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm] 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 S LINE="",$P(LINE,"*",81)="" -
Scheduling/trunk/m/BSDX30.m
r951 r968 1 1 BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007 1:54 PM ] 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX31.m
r951 r968 1 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDX32.m
r965 r968 1 1 BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:21am 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; … … 20 20 HOSPLOC(BSDXY) ;EP 21 21 ;Called by BSDX HOSPITAL LOCATION 22 22 ;Returns all hospital locations that are active 23 23 ; 24 24 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD … … 34 34 . Q:'+BSDXIEN>0 35 35 . Q:'$D(^SC(+BSDXIEN,0)) 36 36 . ;Q:'$$INDIV^BSDX01(+BSDXIEN) ; if not in the same division, quit 37 37 . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE 38 38 . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE -
Scheduling/trunk/m/BSDX33.m
r951 r968 1 1 BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; Mods by WV/STAR 4 4 ; -
Scheduling/trunk/m/BSDX34.m
r951 r968 1 1 BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; Change Log: -
Scheduling/trunk/m/BSDX35.m
r951 r968 1 1 BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ; -
Scheduling/trunk/m/BSDXAPI.m
r961 r968 1 BSDXAPI 2 ;;1.4;BSDX;;Sep 07, 2010;Build 73 4 5 6 7 8 9 10 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) 11 12 13 14 15 16 17 18 19 20 21 22 23 24 MAKE(BSDR) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 CHECKIN1(DFN,CLIN,APDATE) 113 114 115 116 117 118 119 120 121 122 123 CHECKIN(BSDR) 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 CANCEL(BSDR) 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 CI(PAT,CLINIC,DATE,SDIEN) 252 253 254 255 256 257 258 SCIEN(PAT,CLINIC,DATE) 259 260 261 262 263 264 265 APPTYP(PAT,DATE) 266 267 268 269 CO(PAT,CLINIC,DATE,SDIEN) 270 271 272 273 274 275 1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm 2 ;;1.41;BSDX;;Sep 29, 2010;Build 7 3 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW 4 ;local mods (many) by WV/SMH 5 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH 6 ; Change History: 7 ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment. 8 ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API. 9 ; 10 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment 11 ; Call like this for DFN 23435 having an appointment at Hospital Location 33 12 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt 13 ; for Baby foxes hallucinations. 14 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") 15 S BSDR("PAT")=DFN ;DFN 16 S BSDR("CLN")=CLIN ;Hosp Loc IEN 17 S BSDR("TYP")=TYP ;3 sched or 4 walkin 18 S BSDR("ADT")=DATE ;Appointment date in FM format 19 S BSDR("LEN")=LEN ;Appt len upto 240 (min) 20 S BSDR("INFO")=INFO ;Reason for appt - up to 150 char 21 S BSDR("USR")=DUZ ;Person who made appt - current user 22 Q $$MAKE(.BSDR) 23 ; 24 MAKE(BSDR) ;PEP; call to store appt made 25 ; 26 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY) 27 ; 28 ; Input Array - 29 ; BSDR("PAT") = ien of patient in file 2 30 ; BSDR("CLN") = ien of clinic in file 44 31 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins 32 ; BSDR("ADT") = appointment date and time 33 ; BSDR("LEN") = appointment length in minutes (5-120) 34 ; BSDR("OI") = reason for appt - up to 150 characters 35 ; BSDR("USR") = user who made appt 36 ; 37 ;Output: error status and message 38 ; = 0 or null: everything okay 39 ; = 1^message: error and reason 40 ; 41 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 42 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 43 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) 44 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 45 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 46 ; 47 I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) 48 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 49 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") 50 ; 51 NEW DIC,DA,Y,X,DD,DO,DLAYGO 52 ; 53 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D 54 . ; "un-cancel" existing appt in file 2 55 . N BSDXFDA,BSDXIENS,BSDXMSG 56 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," 57 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") 58 . S BSDXFDA(2.98,BSDXIENS,"3")="" 59 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 60 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 61 . S BSDXFDA(2.98,BSDXIENS,"14")="" 62 . S BSDXFDA(2.98,BSDXIENS,"15")="" 63 . S BSDXFDA(2.98,BSDXIENS,"16")="" 64 . S BSDXFDA(2.98,BSDXIENS,"19")="" 65 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 66 . D FILE^DIE("","BSDXFDA","BSDXMSG") 67 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) 68 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 69 . N BSDXFDA,BSDXIENS,BSDXMSG 70 . S BSDXIENS="?+2,"_BSDR("PAT")_"," 71 . S BSDXIENS(2)=BSDR("ADT") 72 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") 73 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 74 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 75 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 76 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") 77 ; add appt to file 44 78 K DIC,DA,X,Y,DLAYGO,DD,DO 79 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" 80 I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT") 81 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") 82 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 83 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 84 ; 85 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh 86 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM 87 ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 88 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") 89 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") 90 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 91 ;D FILE^DICN 92 ; 93 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_"," 94 N BSDXFDA 95 S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT") 96 S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN") 97 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150) 98 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR") 99 S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".") 100 N BSDXERR 101 D UPDATE^DIE("","BSDXFDA","","BSDXERR") 102 ; 103 I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1) 104 ; 105 ; call event driver 106 NEW DFN,SDT,SDCL,SDDA,SDMODE 107 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 108 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 109 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) 110 Q 0 111 ; 112 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in 113 ; Call like this for DFN 23435 checking in now at Hospital Location 33 114 ; for appt at Dec 20, 2009 @ 10:11:59 115 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) 116 S BSDR("PAT")=DFN ;DFN 117 S BSDR("CLN")=CLIN ;Hosp Loc IEN 118 S BSDR("ADT")=APDATE ;Appt Date 119 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now 120 S BSDR("USR")=DUZ ;Check-in user defaults to current 121 Q $$CHECKIN(.BSDR) 122 ; 123 CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002 124 ; 125 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY) 126 ; 127 ; Input array - 128 ; BSDR("PAT") = ien of patient in file 2 129 ; BSDR("CLN") = ien of clinic in file 44 130 ; BSDR("ADT") = appt date/time 131 ; BSDR("CDT") = checkin date/time 132 ; BSDR("USR") = checkin user 133 ; 134 ; Output value - 135 ; = 0 means everything worked 136 ; = 1^message means error with reason message 137 ; 138 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 139 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 140 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 141 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 142 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds 143 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) 144 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 145 ; 146 ; find ien for appt in file 44 147 NEW IEN,DIE,DA,DR 148 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 149 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 150 ; 151 ; remember before status 152 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL 153 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 154 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 155 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 156 ; 157 ; set checkin 158 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 159 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 160 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT 161 D ^DIE 162 ; 163 ; set after status 164 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 165 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 166 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 167 ; 168 ; call event driver 169 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) 170 Q 0 171 ; 172 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment 173 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33, 174 ; cancellation initiated by patient ("PC" rather than clinic "C"), 175 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather) 176 ; because foxes come out during bad weather. 177 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") 178 S BSDR("PAT")=DFN 179 S BSDR("CLN")=CLIN 180 S BSDR("TYP")=TYP 181 S BSDR("ADT")=APDATE 182 S BSDR("CDT")=$$NOW^XLFDT 183 S BSDR("USR")=DUZ 184 S BSDR("CR")=REASON 185 S BSDR("NOT")=INFO 186 Q $$CANCEL(.BSDR) 187 ; 188 CANCEL(BSDR) ;PEP; called to cancel appt 189 ; 190 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY) 191 ; 192 ; Input Array - 193 ; BSDR("PAT") = ien of patient in file 2 194 ; BSDR("CLN") = ien of clinic in file 44 195 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled 196 ; BSDR("ADT") = appointment date and time 197 ; BSDR("CDT") = cancel date and time 198 ; BSDR("USR") = user who canceled appt 199 ; BSDR("CR") = cancel reason - pointer to file 409.2 200 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters 201 ; 202 ;Output: error status and message 203 ; = 0 or null: everything okay 204 ; = 1^message: error and reason 205 ; 206 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 207 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 208 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) 209 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 210 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 211 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds 212 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) 213 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) 214 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) 215 ; 216 NEW IEN,DIE,DA,DR 217 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 218 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 219 ; 220 I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 221 ; 222 ; remember before status 223 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL 224 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 225 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 226 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) 227 ; 228 ; get user who made appt and date appt made from ^SC 229 ; because data in ^SC will be deleted 230 NEW USER,DATE 231 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) 232 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) 233 ; 234 ; update file 2 info 235 NEW DIE,DA,DR 236 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT 237 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE 238 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) 239 D ^DIE 240 ; 241 ; delete data in ^SC 242 NEW DIK,DA 243 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 244 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 245 D ^DIK 246 ; 247 ; call event driver 248 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) 249 Q 0 250 ; 251 CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in 252 NEW X 253 S X=$G(SDIEN) ;ien sent in call 254 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 255 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U) 256 Q $S(X:1,1:0) 257 ; 258 SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC 259 NEW X,IEN 260 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D 261 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled 262 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X 263 Q $G(IEN) 264 ; 265 APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) 266 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) 267 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") 268 ; 269 CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out 270 NEW X 271 S X=$G(SDIEN) ;ien sent in call 272 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 273 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) 274 Q $S(X:1,1:0) 275 ; -
Scheduling/trunk/m/BSDXGPRV.m
r951 r968 1 1 BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 9/7/10 7:59am 2 ;;1.4 ;BSDX;;Sep 07, 20102 ;;1.41;BSDX;;Sep 29, 2010 3 3 ; 4 4 ;
Note:
See TracChangeset
for help on using the changeset viewer.
