BSDX13 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
Q
AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)")
Q
;
AVDELDT(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
;Cancel availability in a date range
;Called by BSDX CANCEL AV BY DATE
;
;BSDXRESD is BSDX RESOURCE ien
;BSDXSTART and BSDXEND are external dates
;
S X="ERROR^BSDX13",@^%ZOSF("TRAP")
N BMXIEN,BSDXI
S BSDXI=0
S BSDXY="^BSDXTMP("_$J_")"
K ^BSDXTMP($J)
S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
S X=BSDXSTART
S %DT="X" D ^%DT
I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid Start Date") Q
S BSDXSTART=$P(Y,".")
S X=BSDXEND
S %DT="X" D ^%DT
I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid End Date") Q
S BSDXEND=$P(Y,".")_".99999"
I '+BSDXRESD D ERR(0,"AVDELDT-BSDX13: Invalid Resource ID") Q
;
F S BSDXSTART=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART)) Q:'+BSDXSTART Q:BSDXSTART>BSDXEND D
. S BMXIEN=0
. F S BMXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART,BMXIEN)) Q:'+BMXIEN D
. . D CALLDIK(BMXIEN)
;
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
Q
ERROR ;
D ^%ZTER
I '+$G(BSDXI) N BSDXI S BSDXI=999999
S BSDXI=BSDXI+1
D ERR(0,"BSDX13 M Error: <"_$G(%ZTERROR)_">")
Q
;
ERR(BSDXERID,ERRTXT) ;Error processing
S:'+$G(BSDXI) BSDXI=999999
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
AVDEL(BSDXY,BSDXAVID) ;EP
;Called by BSDX CANCEL AVAILABILITY
;Deletes Access block
;BSDXAVID is entry number in BSDX AVAILABILITY file
;Returns error code in recordset field ERRORID
;
S X="ERROR^BSDX13",@^%ZOSF("TRAP")
N BSDXNOD,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXEND,BSDXRSID
;
S BSDXI=0
S BSDXY="^BSDXTMP("_$J_")"
K ^BSDXTMP($J)
S ^BSDXTMP($J,0)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
I '+BSDXAVID D ERR(70) Q
I '$D(^BSDXAB(BSDXAVID,0)) D ERR(70) Q
;
;
;TODO: Test for existing appointments in availability block
; (corresponds to old qryAppointmentBlocksOverlapC
; and AVBlockHasAppointments)
;
;I $$APTINBLK(BSDXAVID) D ERR(20) Q
;
;Delete AVAILABILITY entries
D CALLDIK(BSDXAVID)
;
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
Q
;
CALLDIK(BSDXAVID) ;
;Delete AVAILABILITY entries
;
S DIK="^BSDXAB("
S DA=BSDXAVID
D ^DIK
;
Q
;
APTINBLK(BSDXAVID) ;
;
;NOTE: This Subroutine Not called in current version. Keep code for later use.
;
;N BSDXS,BSDXID,BSDXHIT,BSDXNOD,BSDXE,BSDXSTART,BSDXEND,BSDXRSID
;S BSDXNOD=^BSDXAB(BSDXAVID,0)
;S BSDXSTART=$P(BSDXNOD,U,3)
;S BSDXEND=$P(BSDXNOD,U,4)
;S BSDXRSID=$P(BSDXNOD,U,1)
;I '$D(^BSDXDAPRS("ARSRC",BSDXRSID)) Q 0
;;If any appointments start at the AV block start time:
;I $D(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXSTART)) Q 1
;;Find the first appt time BSDXS on the same day as the av block
;S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,$P(BSDXSTART,".")))
;I BSDXS>BSDXEND Q 0
;;For all the appts that day with start times less
;;than the av block's end time, find any whose end time is
;;greater than the av block's start time
;S BSDXHIT=0
;S BSDXS=BSDXS-.0001
;F S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS)) Q:'+BSDXS Q:BSDXS'<BSDXEND D Q:BSDXHIT
;. S BSDXID=0 F S BSDXID=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS,BSDXID)) Q:'+BSDXID D Q:BSDXHIT
;. . Q:'$D(^BSDXDAPT(BSDXID,0))
;. . S BSDXNOD=^BSDXDAPT(BSDXID,0)
;. . S BSDXE=$P(BSDXNOD,U,2)
;. . I BSDXE>BSDXSTART S BSDXHIT=1 Q
;;
;I BSDXHIT Q 1
Q 0
;
;ERR(ERRNO) ;Error processing
;N BSDXERR
;S BSDXERR=ERRNO+134234112 ;vbObjectError
;S BSDXI=BSDXI+1
;S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
;S BSDXI=BSDXI+1
;S ^BSDXTMP($J,BSDXI)=$C(31)
;Q
BSDX13 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
+4 QUIT
AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)")
+4 QUIT
+5 ;
AVDELDT(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
+1 ;Cancel availability in a date range
+2 ;Called by BSDX CANCEL AV BY DATE
+3 ;
+4 ;BSDXRESD is BSDX RESOURCE ien
+5 ;BSDXSTART and BSDXEND are external dates
+6 ;
+7 SET X="ERROR^BSDX13"
SET @^%ZOSF("TRAP")
+8 NEW BMXIEN,BSDXI
+9 SET BSDXI=0
+10 SET BSDXY="^BSDXTMP("_$JOB_")"
+11 KILL ^BSDXTMP($JOB)
+12 SET ^BSDXTMP($JOB,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)
+13 SET X=BSDXSTART
+14 SET %DT="X"
DO ^%DT
+15 IF Y=-1
DO ERR(0,"AVDELDT-BSDX13: Invalid Start Date")
QUIT
+16 SET BSDXSTART=$PIECE(Y,".")
+17 SET X=BSDXEND
+18 SET %DT="X"
DO ^%DT
+19 IF Y=-1
DO ERR(0,"AVDELDT-BSDX13: Invalid End Date")
QUIT
+20 SET BSDXEND=$PIECE(Y,".")_".99999"
+21 IF '+BSDXRESD
DO ERR(0,"AVDELDT-BSDX13: Invalid Resource ID")
QUIT
+22 ;
+23 FOR
SET BSDXSTART=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART))
IF '+BSDXSTART
QUIT
IF BSDXSTART>BSDXEND
QUIT
Begin DoDot:1
+24 SET BMXIEN=0
+25 FOR
SET BMXIEN=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART,BMXIEN))
IF '+BMXIEN
QUIT
Begin DoDot:2
+26 DO CALLDIK(BMXIEN)
End DoDot:2
End DoDot:1
+27 ;
+28 SET BSDXI=BSDXI+1
+29 SET ^BSDXTMP($JOB,BSDXI)="-1^"_$CHAR(30)_$CHAR(31)
+30 QUIT
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(BSDXI)
NEW BSDXI
SET BSDXI=999999
+3 SET BSDXI=BSDXI+1
+4 DO ERR(0,"BSDX13 M Error: <"_$GET(%ZTERROR)_">")
+5 QUIT
+6 ;
ERR(BSDXERID,ERRTXT) ;Error processing
+1 IF '+$GET(BSDXI)
SET BSDXI=999999
+2 SET BSDXI=BSDXI+1
+3 SET ^BSDXTMP($JOB,BSDXI)=BSDXERID_"^"_ERRTXT_$CHAR(30)
+4 SET BSDXI=BSDXI+1
+5 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+6 QUIT
+7 ;
AVDEL(BSDXY,BSDXAVID) ;EP
+1 ;Called by BSDX CANCEL AVAILABILITY
+2 ;Deletes Access block
+3 ;BSDXAVID is entry number in BSDX AVAILABILITY file
+4 ;Returns error code in recordset field ERRORID
+5 ;
+6 SET X="ERROR^BSDX13"
SET @^%ZOSF("TRAP")
+7 NEW BSDXNOD,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXEND,BSDXRSID
+8 ;
+9 SET BSDXI=0
+10 SET BSDXY="^BSDXTMP("_$JOB_")"
+11 KILL ^BSDXTMP($JOB)
+12 SET ^BSDXTMP($JOB,0)="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)
+13 IF '+BSDXAVID
DO ERR(70)
QUIT
+14 IF '$DATA(^BSDXAB(BSDXAVID,0))
DO ERR(70)
QUIT
+15 ;
+16 ;
+17 ;TODO: Test for existing appointments in availability block
+18 ; (corresponds to old qryAppointmentBlocksOverlapC
+19 ; and AVBlockHasAppointments)
+20 ;
+21 ;I $$APTINBLK(BSDXAVID) D ERR(20) Q
+22 ;
+23 ;Delete AVAILABILITY entries
+24 DO CALLDIK(BSDXAVID)
+25 ;
+26 SET BSDXI=BSDXI+1
+27 SET ^BSDXTMP($JOB,BSDXI)="-1^"_$CHAR(30)_$CHAR(31)
+28 QUIT
+29 ;
CALLDIK(BSDXAVID) ;
+1 ;Delete AVAILABILITY entries
+2 ;
+3 SET DIK="^BSDXAB("
+4 SET DA=BSDXAVID
+5 DO ^DIK
+6 ;
+7 QUIT
+8 ;
APTINBLK(BSDXAVID) ;
+1 ;
+2 ;NOTE: This Subroutine Not called in current version. Keep code for later use.
+3 ;
+4 ;N BSDXS,BSDXID,BSDXHIT,BSDXNOD,BSDXE,BSDXSTART,BSDXEND,BSDXRSID
+5 ;S BSDXNOD=^BSDXAB(BSDXAVID,0)
+6 ;S BSDXSTART=$P(BSDXNOD,U,3)
+7 ;S BSDXEND=$P(BSDXNOD,U,4)
+8 ;S BSDXRSID=$P(BSDXNOD,U,1)
+9 ;I '$D(^BSDXDAPRS("ARSRC",BSDXRSID)) Q 0
+10 ;;If any appointments start at the AV block start time:
+11 ;I $D(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXSTART)) Q 1
+12 ;;Find the first appt time BSDXS on the same day as the av block
+13 ;S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,$P(BSDXSTART,".")))
+14 ;I BSDXS>BSDXEND Q 0
+15 ;;For all the appts that day with start times less
+16 ;;than the av block's end time, find any whose end time is
+17 ;;greater than the av block's start time
+18 ;S BSDXHIT=0
+19 ;S BSDXS=BSDXS-.0001
+20 ;F S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS)) Q:'+BSDXS Q:BSDXS'<BSDXEND D Q:BSDXHIT
+21 ;. S BSDXID=0 F S BSDXID=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS,BSDXID)) Q:'+BSDXID D Q:BSDXHIT
+22 ;. . Q:'$D(^BSDXDAPT(BSDXID,0))
+23 ;. . S BSDXNOD=^BSDXDAPT(BSDXID,0)
+24 ;. . S BSDXE=$P(BSDXNOD,U,2)
+25 ;. . I BSDXE>BSDXSTART S BSDXHIT=1 Q
+26 ;;
+27 ;I BSDXHIT Q 1
+28 QUIT 0
+29 ;
+30 ;ERR(ERRNO) ;Error processing
+31 ;N BSDXERR
+32 ;S BSDXERR=ERRNO+134234112 ;vbObjectError
+33 ;S BSDXI=BSDXI+1
+34 ;S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
+35 ;S BSDXI=BSDXI+1
+36 ;S ^BSDXTMP($J,BSDXI)=$C(31)
+37 ;Q
