BSDX33.m

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

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

 ;

 ;

 Q

RBNEXTD(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP

 ;Entry point for debugging

 ;

 ;D DEBUG^%Serenji("RBNEXT^BSDX33(.BSDXY,BSDXDATE,BSDXRES,BSDXTPID)")

 Q

 ;

RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP

 ;Called by BSDX REBOOK NEXT BLOCK to find

 ;the next ACCESS BLOCK in resource BSDXRES after BSDXSTART

 ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found

 ;Otherwise, returns 0 and error message in ERRORTEXT

 ;If BSDXTPID = 0 then any access type match

 ;

 S X="ERROR2^BSDX33",@^%ZOSF("TRAP")

 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y,BSDXRESD,BSDXFND,BSDXIEN,BSDXNOD,BSDXATID

 S BSDXY="^BSDXTMP("_$J_")"

 S BSDXI=0

 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$C(30)

 ;

 I BSDXRES="" D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q

 I '$D(^BSDXRES("B",BSDXRES)) D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q

 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))

 I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q

 S X=BSDXDATE,%DT="XT" D ^%DT

 I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q

 S BSDXDATE=$P(Y,".")

 ;

 S BSDXFND=0

 F  S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE)) Q:'+BSDXDATE  D  Q:BSDXFND

 . S BSDXIEN=0 F  S BSDXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,BSDXIEN)) Q:'+BSDXIEN  D  Q:BSDXFND

 . . Q:'$D(^BSDXAB(BSDXIEN,0))

 . . S BSDXNOD=^BSDXAB(BSDXIEN,0)

 . . Q:+$P(BSDXNOD,U,4)=0  ;Slots

 . . S BSDXATID=$P(BSDXNOD,U,5)

 . . I BSDXTPID=0!(BSDXATID=BSDXTPID) S BSDXFND=$P(BSDXNOD,U,2) Q

 ;

 I BSDXFND=0 S BSDXFND=""

 E  S Y=BSDXFND X ^DD("DD") S BSDXFND=Y

 S BSDXFND=$TR(BSDXFND,"@"," ")

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31)

 Q

SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP

 ;Entry point for debugging

 ;

 ;D DEBUG^%Serenji("SETRBK^BSDX33(.BSDXY,BSDXAPPT,BSDXDATE)")

 Q

 ;

SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP

 ;

 ;Sets rebook date into appointment

 ;BSDXAPPT - Appointment ID

 ;BSDXDATE - Rebook Datetime in external format

 ;Called by BSDX REBOOK SET

 ;

 ;ErrorID:

 ; 0 if a problem.  Message in ERRORTEXT

 ; 1 if OK

 ;

 S X="ERROR^BSDX33",@^%ZOSF("TRAP")

 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y

 S BSDXY="^BSDXTMP("_$J_")"

 S BSDXI=0

 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)

 ;

 I '+BSDXAPPT

 I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q

 S X=BSDXDATE,%DT="XT" D ^%DT

 I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q

 S BSDXDATE=Y

 S BSDXIENS=BSDXAPPT_","

 S BSDXFDA(9002018.4,BSDXIENS,.11)=BSDXDATE

 ;

 K BSDXMSG

 D FILE^DIE("","BSDXFDA","BSDXMSG")

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)="1^"_$C(31)

 ;

 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

 ;

ERROR ;

 D ^%ZTER

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

 S BSDXI=BSDXI+1

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

 Q

 ;

ERR2(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

 ;

ERROR2 ;

 D ^%ZTER

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

 S BSDXI=BSDXI+1

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

 Q

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

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

 +2       ;

 +3       ;

 +4        QUIT 

RBNEXTD(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP

 +1       ;Entry point for debugging

 +2       ;

 +3       ;D DEBUG^%Serenji("RBNEXT^BSDX33(.BSDXY,BSDXDATE,BSDXRES,BSDXTPID)")

 +4        QUIT 

 +5       ;

RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP

 +1       ;Called by BSDX REBOOK NEXT BLOCK to find

 +2       ;the next ACCESS BLOCK in resource BSDXRES after BSDXSTART

 +3       ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found

 +4       ;Otherwise, returns 0 and error message in ERRORTEXT

 +5       ;If BSDXTPID = 0 then any access type match

 +6       ;

 +7        SET X="ERROR2^BSDX33"

           SET @^%ZOSF("TRAP")

 +8        NEW BSDXI,BSDXIENS,%DT,BSDXMSG,Y,BSDXRESD,BSDXFND,BSDXIEN,BSDXNOD,BSDXATID

 +9        SET BSDXY="^BSDXTMP("_$JOB_")"

 +10       SET BSDXI=0

 +11       SET ^BSDXTMP($JOB,BSDXI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$CHAR(30)

 +12      ;

 +13       IF BSDXRES=""

               DO ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name")

               QUIT 

 +14       IF '$DATA(^BSDXRES("B",BSDXRES))

               DO ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name")

               QUIT 

 +15       SET BSDXRESD=$ORDER(^BSDXRES("B",BSDXRES,0))

 +16       IF '+BSDXRESD

               DO ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name")

               QUIT 

 +17       SET X=BSDXDATE

           SET %DT="XT"

           DO ^%DT

 +18       IF Y=-1

               DO ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime")

               QUIT 

 +19       SET BSDXDATE=$PIECE(Y,".")

 +20      ;

 +21       SET BSDXFND=0

 +22       FOR 

               SET BSDXDATE=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE))

               IF '+BSDXDATE

                   QUIT 

               Begin DoDot:1

 +23               SET BSDXIEN=0

                   FOR 

                       SET BSDXIEN=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,BSDXIEN))

                       IF '+BSDXIEN

                           QUIT 

                       Begin DoDot:2

 +24                       IF '$DATA(^BSDXAB(BSDXIEN,0))

                               QUIT 

 +25                       SET BSDXNOD=^BSDXAB(BSDXIEN,0)

 +26      ;Slots

                           IF +$PIECE(BSDXNOD,U,4)=0

                               QUIT 

 +27                       SET BSDXATID=$PIECE(BSDXNOD,U,5)

 +28                       IF BSDXTPID=0!(BSDXATID=BSDXTPID)

                               SET BSDXFND=$PIECE(BSDXNOD,U,2)

                               QUIT 

                       End DoDot:2

                       IF BSDXFND

                           QUIT 

               End DoDot:1

               IF BSDXFND

                   QUIT 

 +29      ;

 +30       IF BSDXFND=0

               SET BSDXFND=""

 +31      IF '$TEST

               SET Y=BSDXFND

               XECUTE ^DD("DD")

               SET BSDXFND=Y

 +32       SET BSDXFND=$TRANSLATE(BSDXFND,"@"," ")

 +33       SET BSDXI=BSDXI+1

 +34       SET ^BSDXTMP($JOB,BSDXI)="1^"_BSDXFND_"^"_$CHAR(30)_$CHAR(31)

 +35       QUIT 

SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP

 +1       ;Entry point for debugging

 +2       ;

 +3       ;D DEBUG^%Serenji("SETRBK^BSDX33(.BSDXY,BSDXAPPT,BSDXDATE)")

 +4        QUIT 

 +5       ;

SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP

 +1       ;

 +2       ;Sets rebook date into appointment

 +3       ;BSDXAPPT - Appointment ID

 +4       ;BSDXDATE - Rebook Datetime in external format

 +5       ;Called by BSDX REBOOK SET

 +6       ;

 +7       ;ErrorID:

 +8       ; 0 if a problem.  Message in ERRORTEXT

 +9       ; 1 if OK

 +10      ;

 +11       SET X="ERROR^BSDX33"

           SET @^%ZOSF("TRAP")

 +12       NEW BSDXI,BSDXIENS,%DT,BSDXMSG,Y

 +13       SET BSDXY="^BSDXTMP("_$JOB_")"

 +14       SET BSDXI=0

 +15       SET ^BSDXTMP($JOB,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)

 +16      ;

 +17       IF '+BSDXAPPT

 +18       IF '$DATA(^BSDXAPPT(BSDXAPPT,0))

               DO ERR(1,"BSDX REBOOK SET: Invalid appointment ID")

               QUIT 

 +19       SET X=BSDXDATE

           SET %DT="XT"

           DO ^%DT

 +20       IF Y=-1

               DO ERR(1,"BSDX REBOOK SET: Invalid rebook datetime")

               QUIT 

 +21       SET BSDXDATE=Y

 +22       SET BSDXIENS=BSDXAPPT_","

 +23       SET BSDXFDA(9002018.4,BSDXIENS,.11)=BSDXDATE

 +24      ;

 +25       KILL BSDXMSG

 +26       DO FILE^DIE("","BSDXFDA","BSDXMSG")

 +27       SET BSDXI=BSDXI+1

 +28       SET ^BSDXTMP($JOB,BSDXI)="1^"_$CHAR(31)

 +29      ;

 +30       QUIT 

 +31      ;

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       ;

ERROR     ;

 +1        DO ^%ZTER

 +2        IF '+$GET(BSDXI)

               NEW BSDXI

               SET BSDXI=999999

 +3        SET BSDXI=BSDXI+1

 +4        DO ERR(0,"BSDX33 M Error: <"_$GET(%ZTERROR)_">")

 +5        QUIT 

 +6       ;

ERR2(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       ;

ERROR2    ;

 +1        DO ^%ZTER

 +2        IF '+$GET(BSDXI)

               NEW BSDXI

               SET BSDXI=999999

 +3        SET BSDXI=BSDXI+1

 +4        DO ERR2(0,"BSDX33 M Error: <"_$GET(%ZTERROR)_">")

 +5        QUIT