BSDX06 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
TPBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
;Called by BSDXD TYPE BLOCKS OVERLAP
;(Duplicates old qryTypeBlocksOverlapB)
;BSDXRES is resource name
;
;Test lines:
;D TPBLKOV^BSDX06(.RES,"5-12-2003","5-16-2003","REMILLARD,MIKE") ZW RES
;BSDX TYPE BLOCKS OVERLAP^1-1-2000^12-14-2004^REMILLARD,MIKE
;S ^HW("BSDXD06")=BSDXSTART_U_BSDXEND_U_BSDXRES
;
N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXTPID,BSDXNOD,BSDXAD
K ^BSDXTMP($J)
S BSDXERR=""
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="D00030StartTime^D00030EndTime^I00010AppointmentTypeID^I00010AvailabilityID^T00030ResourceName"_$C(30)
S BSDXI=0
D
. S BSDXBS=0
. S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
. S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
. S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
. I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
. S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
. I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
. I $L(BSDXEND,".")=1 S BSDXEND=BSDXEND+.9999 ;Go to end of day
. S BSDXRESN=BSDXRES
. Q:BSDXRESN=""
. Q:'$D(^BSDXRES("B",BSDXRESN))
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
. Q:'+BSDXRESD
. D STCOMM(BSDXRESN,BSDXRESD)
. Q
;
S BSDXI=$G(BSDXI)+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
STCOMM(BSDXRESN,BSDXRESD) ;EP
;
Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
Q:'$D(^BSDXRES(BSDXRESD,0))
;$O THRU "ARSCT" XREF OF ^BSDXAB
S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
;Start at the beginning of the day -- AV Blocks can't overlap days
S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
F S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
. S BSDXAD=0 F S BSDXAD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D
. . Q:'$D(^BSDXAB(BSDXAD,0))
. . S BSDXNOD=^BSDXAB(BSDXAD,0)
. . S BSDXNSTART=$P(BSDXNOD,U,2)
. . S BSDXNEND=$P(BSDXNOD,U,3)
. . I BSDXNEND'>BSDXSTART Q
. . S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
. . S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
. . S BSDXTPID=$P(BSDXNOD,U,5)
. . S BSDXI=BSDXI+1
. . S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXTPID_U_BSDXAD_U_BSDXRESN_$C(30)
. . Q
. Q
Q
BSDX06 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
TPBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
+1 ;Called by BSDXD TYPE BLOCKS OVERLAP
+2 ;(Duplicates old qryTypeBlocksOverlapB)
+3 ;BSDXRES is resource name
+4 ;
+5 ;Test lines:
+6 ;D TPBLKOV^BSDX06(.RES,"5-12-2003","5-16-2003","REMILLARD,MIKE") ZW RES
+7 ;BSDX TYPE BLOCKS OVERLAP^1-1-2000^12-14-2004^REMILLARD,MIKE
+8 ;S ^HW("BSDXD06")=BSDXSTART_U_BSDXEND_U_BSDXRES
+9 ;
+10 NEW BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXTPID,BSDXNOD,BSDXAD
+11 KILL ^BSDXTMP($JOB)
+12 SET BSDXERR=""
+13 SET BSDXY="^BSDXTMP("_$JOB_")"
+14 SET ^BSDXTMP($JOB,0)="D00030StartTime^D00030EndTime^I00010AppointmentTypeID^I00010AvailabilityID^T00030ResourceName"_$CHAR(30)
+15 SET BSDXI=0
+16 Begin DoDot:1
+17 SET BSDXBS=0
+18 IF BSDXSTART["@0000"
SET BSDXSTART=$PIECE(BSDXSTART,"@")
+19 IF BSDXEND["@0000"
SET BSDXEND=$PIECE(BSDXEND,"@")
+20 SET %DT="T"
SET X=BSDXSTART
DO ^%DT
SET BSDXSTART=Y
+21 IF BSDXSTART=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+22 SET %DT="T"
SET X=BSDXEND
DO ^%DT
SET BSDXEND=Y
+23 IF BSDXEND=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+24 ;Go to end of day
IF $LENGTH(BSDXEND,".")=1
SET BSDXEND=BSDXEND+.9999
+25 SET BSDXRESN=BSDXRES
+26 IF BSDXRESN=""
QUIT
+27 IF '$DATA(^BSDXRES("B",BSDXRESN))
QUIT
+28 SET BSDXRESD=$ORDER(^BSDXRES("B",BSDXRESN,0))
+29 IF '+BSDXRESD
QUIT
+30 DO STCOMM(BSDXRESN,BSDXRESD)
+31 QUIT
End DoDot:1
+32 ;
+33 SET BSDXI=$GET(BSDXI)+1
+34 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+35 QUIT
+36 ;
STCOMM(BSDXRESN,BSDXRESD) ;EP
+1 ;
+2 IF '$DATA(^BSDXAB("ARSCT",BSDXRESD))
QUIT
+3 IF '$DATA(^BSDXRES(BSDXRESD,0))
QUIT
+4 ;$O THRU "ARSCT" XREF OF ^BSDXAB
+5 SET BSDXNEND=0
SET BSDXNSTART=0
SET BSDXPEND=0
+6 ;Start at the beginning of the day -- AV Blocks can't overlap days
+7 SET BSDXS=$PIECE(BSDXSTART,".")
SET BSDXS=BSDXS-.0001
+8 FOR
SET BSDXS=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXS))
IF '+BSDXS
QUIT
IF BSDXS>BSDXEND
QUIT
Begin DoDot:1
+9 SET BSDXAD=0
FOR
SET BSDXAD=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD))
IF '+BSDXAD
QUIT
Begin DoDot:2
+10 IF '$DATA(^BSDXAB(BSDXAD,0))
QUIT
+11 SET BSDXNOD=^BSDXAB(BSDXAD,0)
+12 SET BSDXNSTART=$PIECE(BSDXNOD,U,2)
+13 SET BSDXNEND=$PIECE(BSDXNOD,U,3)
+14 IF BSDXNEND'>BSDXSTART
QUIT
+15 SET Y=BSDXNSTART
XECUTE ^DD("DD")
SET BSDXNSTART=$TRANSLATE(Y,"@"," ")
+16 SET Y=BSDXNEND
XECUTE ^DD("DD")
SET BSDXNEND=$TRANSLATE(Y,"@"," ")
+17 SET BSDXTPID=$PIECE(BSDXNOD,U,5)
+18 SET BSDXI=BSDXI+1
+19 SET ^BSDXTMP($JOB,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXTPID_U_BSDXAD_U_BSDXRESN_$CHAR(30)
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 QUIT
