1 | BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
|
---|
2 | ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
|
---|
3 | ;
|
---|
4 | ;
|
---|
5 | TPBLKOV(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 | ;
|
---|
42 | STCOMM(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
|
---|