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
