- 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
