source: Scheduling/trunk/m/BSDX06.m@ 760

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

Initial committ of scheduling package

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