Changeset 968 for Scheduling/trunk
- Timestamp:
- Sep 29, 2010, 3:48:57 AM (15 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 ;if not linked, always returned.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 . ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit63 . ; 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 . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered122 . ;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 . K BSDXRDAT125 . 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 . ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user.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 . . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division225 . . ;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) ; PEP - Is ^SC clinic in the same DUZ(2) as user?260 ; Input: BSDXSC - Hospital Location IEN261 ; Output: True or False262 I '+BSDXSC QUIT 1 ;If not tied to clinic, yes263 I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes264 ; Jump to Division:Medical Center Division:Inst File Pointer for265 ; 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 Clinic269 E Q 0 ; Otherwise, no270 QUIT271 INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?272 ; Input BSDXRES - BSDX RESOURCE IEN273 ; Output: True of False274 Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV275 UnitTestINDIV 276 W "Testing if they are the same",!277 S DUZ(2)=67278 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)=899286 I $$INDIV(1) W "ERROR",!287 I $$INDIV(2) W "ERROR",!288 QUIT289 UnitTestINDIV2 290 W "Testing if they are the same",!291 S DUZ(2)=69292 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 QUIT259 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 ;Returns all hospital locations that are active22 ;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 . ;Q:'$$INDIV^BSDX01(+BSDXIEN) ; if not in the same division, quit36 . ;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 ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm2 ;;1.4;BSDX;;Sep 07, 2010;Build 73 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW4 ;local mods (many) by WV/SMH5 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH6 ; 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 appointment11 ; Call like this for DFN 23435 having an appointment at Hospital Location 3312 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt13 ; 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 ;DFN16 S BSDR("CLN")=CLIN ;Hosp Loc IEN17 S BSDR("TYP")=TYP ;3 sched or 4 walkin18 S BSDR("ADT")=DATE ;Appointment date in FM format19 S BSDR("LEN")=LEN ;Appt len upto 240 (min)20 S BSDR("INFO")=INFO ;Reason for appt - up to 150 char21 S BSDR("USR")=DUZ ;Person who made appt - current user22 Q $$MAKE(.BSDR)23 ;24 MAKE(BSDR) ;PEP; call to store appt made25 ;26 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)27 ;28 ; Input Array -29 ; BSDR("PAT") = ien of patient in file 230 ; BSDR("CLN") = ien of clinic in file 4431 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins32 ; BSDR("ADT") = appointment date and time33 ; BSDR("LEN") = appointment length in minutes (5-120)34 ; BSDR("OI") = reason for appt - up to 150 characters35 ; BSDR("USR") = user who made appt36 ;37 ;Output: error status and message38 ; = 0 or null: everything okay39 ; = 1^message: error and reason40 ;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 seconds45 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,DLAYGO52 ;53 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D54 . ; "un-cancel" existing appt in file 255 . N BSDXFDA,BSDXIENS,BSDXMSG56 . 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")=961 . 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^XLFDT66 . 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,BSDXMSG70 . 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")=975 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT76 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")77 ; add appt to file 4478 K DIC,DA,X,Y,DLAYGO,DD,DO79 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.00183 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN84 ;85 ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh86 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM87 ;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.00391 ;D FILE^DICN92 ;93 N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","94 N BSDXFDA95 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 BSDXERR101 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 driver106 NEW DFN,SDT,SDCL,SDDA,SDMODE107 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2108 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))109 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)110 Q 0111 ;112 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in113 ; Call like this for DFN 23435 checking in now at Hospital Location 33114 ; for appt at Dec 20, 2009 @ 10:11:59115 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)116 S BSDR("PAT")=DFN ;DFN117 S BSDR("CLN")=CLIN ;Hosp Loc IEN118 S BSDR("ADT")=APDATE ;Appt Date119 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now120 S BSDR("USR")=DUZ ;Check-in user defaults to current121 Q $$CHECKIN(.BSDR)122 ;123 CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002124 ;125 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)126 ;127 ; Input array -128 ; BSDR("PAT") = ien of patient in file 2129 ; BSDR("CLN") = ien of clinic in file 44130 ; BSDR("ADT") = appt date/time131 ; BSDR("CDT") = checkin date/time132 ; BSDR("USR") = checkin user133 ;134 ; Output value -135 ; = 0 means everything worked136 ; = 1^message means error with reason message137 ;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 seconds141 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 seconds143 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 44147 NEW IEN,DIE,DA,DR148 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 status152 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL153 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN154 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL155 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)156 ;157 ; set checkin158 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"159 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN160 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT161 D ^DIE162 ;163 ; set after status164 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))165 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL166 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)167 ;168 ; call event driver169 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)170 Q 0171 ;172 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment173 ; 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")=DFN179 S BSDR("CLN")=CLIN180 S BSDR("TYP")=TYP181 S BSDR("ADT")=APDATE182 S BSDR("CDT")=$$NOW^XLFDT183 S BSDR("USR")=DUZ184 S BSDR("CR")=REASON185 S BSDR("NOT")=INFO186 Q $$CANCEL(.BSDR)187 ;188 CANCEL(BSDR) ;PEP; called to cancel appt189 ;190 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)191 ;192 ; Input Array -193 ; BSDR("PAT") = ien of patient in file 2194 ; BSDR("CLN") = ien of clinic in file 44195 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled196 ; BSDR("ADT") = appointment date and time197 ; BSDR("CDT") = cancel date and time198 ; BSDR("USR") = user who canceled appt199 ; BSDR("CR") = cancel reason - pointer to file 409.2200 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters201 ;202 ;Output: error status and message203 ; = 0 or null: everything okay204 ; = 1^message: error and reason205 ;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 seconds210 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 seconds212 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,DR217 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 status223 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL224 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN225 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL226 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)227 ;228 ; get user who made appt and date appt made from ^SC229 ; because data in ^SC will be deleted230 NEW USER,DATE231 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 info235 NEW DIE,DA,DR236 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT237 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE238 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)239 D ^DIE240 ;241 ; delete data in ^SC242 NEW DIK,DA243 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"244 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN245 D ^DIK246 ;247 ; call event driver248 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)249 Q 0250 ;251 CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in252 NEW X253 S X=$G(SDIEN) ;ien sent in call254 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0255 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 ^SC259 NEW X,IEN260 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D261 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled262 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X263 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-out270 NEW X271 S X=$G(SDIEN) ;ien sent in call272 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0273 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)274 Q $S(X:1,1:0)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.
