source: Scheduling/trunk/m/BSDX05.m@ 953

Last change on this file since 953 was 951, checked in by Sam Habiel, 14 years ago

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason

File size: 2.0 KB
RevLine 
[874]1BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm
[951]2 ;;1.4;BSDX;;Sep 07, 2010
[614]3 ;
[888]4 ; Change Log:
5 ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
[614]6 ;
7APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
8 ;Called by BSDX APPT BLOCKS OVERLAP
[888]9 ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
[614]10 ;(Duplicates old qryAppointmentBlocksOverlapB)
11 ;BSDXRES is resource name
12 ;
13 ;Test lines:
14 ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
15 ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
16 ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
17 ;
18 N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD
19 K ^BSDXTMP($J)
20 S BSDXERR=""
21 S BSDXY="^BSDXTMP("_$J_")"
22 S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME"_$C(30)
23 D
24 . S BSDXBS=0
[854]25 . S BSDXEND=BSDXEND+.9999 ;Go to end of day
[614]26 . S BSDXRESN=BSDXRES
27 . Q:BSDXRESN=""
28 . Q:'$D(^BSDXRES("B",BSDXRESN))
29 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
30 . Q:'+BSDXRESD
31 . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
32 . D STRES(BSDXRESD,BSDXSTART,BSDXEND)
33 . Q
34 ;
35 S BSDXI=$G(BSDXI)+1
36 S ^BSDXTMP($J,BSDXI)=$C(31)
37 Q
38 ;
39STRES(BSDXRESD,BSDXSTART,BSDXEND) ;
40 ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
41 ;Start at the beginning of the day -- appts can't overlap days
42 S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
43 S BSDXI=0
44 F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
45 . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD) ;BSDXAD Is the AppointmentID
46 . Q
47 Q
48 ;
49STCOMM(BSDXAD) ;
50 S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
51 Q:'$D(^BSDXAPPT(BSDXAD,0))
52 S BSDXNOD=^BSDXAPPT(BSDXAD,0)
53 Q:$P(BSDXNOD,U,10)=1 ;NO-SHOW Flag
54 Q:$P(BSDXNOD,U,12)]"" ;CANCELLED APPT
55 Q:$P(BSDXNOD,U,13)="y" ;WALKIN
56 S BSDXNSTART=$P(BSDXNOD,U)
57 S BSDXNEND=$P(BSDXNOD,U,2)
58 I BSDXNEND'>BSDXSTART Q ;End is less than start
59 S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
60 S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
61 S BSDXI=BSDXI+1
62 S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_$C(30)
63 Q
Note: See TracBrowser for help on using the repository browser.