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

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

Bumped version up to 1.41

File size: 2.0 KB
Line 
1BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm
2 ;;1.41;BSDX;;Sep 29, 2010
3 ;
4 ; Change Log:
5 ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
6 ;
7APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
8 ;Called by BSDX APPT BLOCKS OVERLAP
9 ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
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
25 . S BSDXEND=BSDXEND+.9999 ;Go to end of day
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.