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

Last change on this file since 788 was 614, checked in by Sam Habiel, 15 years ago

Initial committ of scheduling package

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