Routine: BSDX13

BSDX13 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP

 ;Entry point for debugging

 ;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)")

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)

ERROR ;

 D ^%ZTER

 I '+$G(BSDXI) N BSDXI S BSDXI=999999

 S BSDXI=BSDXI+1

 D ERR(0,"BSDX13 M Error: <"_$G(%ZTERROR)_">")

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)

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)

CALLDIK(BSDXAVID) ;

 ;Delete AVAILABILITY entries

 S DIK="^BSDXAB("

 S DA=BSDXAVID

 D ^DIK

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

BSDX13.m