SDEC33 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
;
Q
;
REBKNEXT(SDECY,SDECDATE,SDECRES,SDECTPID) ; find the next ACCESS BLOCK in resource SDECRES after SDECSTART
;REBKNEXT(SDECY,SDECDATE,SDECRES,SDECTPID) external parameter tag is in SDEC
;SDECDATE - Date in external form
;SDECRES - Resource Name from the NAME field of the SDEC RESOURCE file
;SDECTPID - Access Type Id - Pointer to the SDEC ACCESS TYPE file
;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 SDECTPID = 0 then any access type match
;
N SDAB,SDECI,SDECIENS,SDI,%DT,SDECMSG,X,Y,SDECRESD,SDECFND,SDECIEN,SDECNOD,SDECATID
S SDAB="^TMP("_$J_",""SDEC"",""BLKS"")"
K @SDAB
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$C(30)
;
I SDECRES="" D ERR2("","SDEC REBOOK NEXT BLOCK: Invalid resource name") Q
I '$D(^SDEC(409.831,"B",SDECRES)) D ERR2(SDECRES,"SDEC REBOOK NEXT BLOCK: Invalid resource name") Q
S SDECRESD=$O(^SDEC(409.831,"B",SDECRES,0))
I '+SDECRESD D ERR2(SDECRES,"SDEC REBOOK NEXT BLOCK: Invalid resource name") Q
S X=SDECDATE,%DT="XT" D ^%DT
I Y=-1 D ERR2(1,"SDEC REBOOK NEXT BLOCK: Invalid datetime") Q
S SDECDATE=$P(Y,".")
;
S SDECFND=0
D GETSLOTS^SDEC04(SDAB,SDECRESD,SDECDATE,$$FMADD^XLFDT(SDECDATE,10))
S SDI=0 F S SDI=$O(@SDAB@(SDI)) Q:SDI'>0 D
.S SDECNOD=@SDAB@(SDI)
.Q:+$P(SDECNOD,U,4)=0 ;Slots
.S SDECATID=$P(SDECNOD,U,5)
.I SDECTPID=0!(SDECATID=SDECTPID) S SDECFND=$P(SDECNOD,U,2) Q
;
I SDECFND=0 S SDECFND=""
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
E S SDECFND=$$FMTONET^SDECDATE(SDECFND,"Y") ;
;E S Y=SDECFND X ^DD("DD") S SDECFND=Y
;S SDECFND=$TR(SDECFND,"@"," ")
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="1^"_SDECFND_"^"_$C(30)_$C(31)
Q
;
SETRBOOK(SDECY,SDECAPPT,SDECDATE) ;Sets rebook date into appointment
;SETRBOOK(SDECY,SDECAPPT,SDECDATE) external parameter tag is in SDEC
;SDECAPPT - Appointment ID
;SDECDATE - Rebook Datetime in external format
;Called by SDEC REBOOK SET
;
;ErrorID:
; 0 if a problem. Message in ERRORTEXT
; 1 if OK
;
N SDECFDA,SDECI,SDECIENS,%DT,SDECMSG,X,Y
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
;
I '+SDECAPPT
I '$D(^SDEC(409.84,SDECAPPT,0)) D ERR(1,"SDEC REBOOK SET: Invalid appointment ID") Q
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
S SDECDATE=$$NETTOFM^SDECDATE(SDECDATE,"Y","N") I SDECDATE=-1 D ERR(1,"SDEC REBOOK SET: Invalid rebook datetime") Q
;S X=SDECDATE,%DT="XT" D ^%DT
;I Y=-1 D ERR(1,"SDEC REBOOK SET: Invalid rebook datetime") Q
;S SDECDATE=Y
S SDECIENS=SDECAPPT_","
S SDECFDA(409.84,SDECIENS,.11)=SDECDATE
;
K SDECMSG
D FILE^DIE("","SDECFDA","SDECMSG")
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="1^"_$C(31)
;
Q
;
ERR(SDECERID,ERRTXT) ;Error processing
S:'+$G(SDECI) SDECI=999999
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECERID_"^"_ERRTXT_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ERROR ;
D ^%ZTER
I '+$G(SDECI) N SDECI S SDECI=999999
S SDECI=SDECI+1
D ERR(0,"SDEC33 Error")
Q
;
ERR2(SDECERID,ERRTXT) ;Error processing
S:'+$G(SDECI) SDECI=999999
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECERID_"^^"_ERRTXT_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ERROR2 ;
D ^%ZTER
I '+$G(SDECI) N SDECI S SDECI=999999
S SDECI=SDECI+1
D ERR2(0,"SDEC33 Error")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC33 3750 printed Sep 11, 2024@03:10:13 Page 2
SDEC33 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
+2 ;
+3 QUIT
+4 ;
REBKNEXT(SDECY,SDECDATE,SDECRES,SDECTPID) ; find the next ACCESS BLOCK in resource SDECRES after SDECSTART
+1 ;REBKNEXT(SDECY,SDECDATE,SDECRES,SDECTPID) external parameter tag is in SDEC
+2 ;SDECDATE - Date in external form
+3 ;SDECRES - Resource Name from the NAME field of the SDEC RESOURCE file
+4 ;SDECTPID - Access Type Id - Pointer to the SDEC ACCESS TYPE file
+5 ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found
+6 ;Otherwise, returns 0 and error message in ERRORTEXT
+7 ;If SDECTPID = 0 then any access type match
+8 ;
+9 NEW SDAB,SDECI,SDECIENS,SDI,%DT,SDECMSG,X,Y,SDECRESD,SDECFND,SDECIEN,SDECNOD,SDECATID
+10 SET SDAB="^TMP("_$JOB_",""SDEC"",""BLKS"")"
+11 KILL @SDAB
+12 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+13 KILL @SDECY
+14 SET SDECI=0
+15 SET ^TMP("SDEC",$JOB,SDECI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$CHAR(30)
+16 ;
+17 IF SDECRES=""
DO ERR2("","SDEC REBOOK NEXT BLOCK: Invalid resource name")
QUIT
+18 IF '$DATA(^SDEC(409.831,"B",SDECRES))
DO ERR2(SDECRES,"SDEC REBOOK NEXT BLOCK: Invalid resource name")
QUIT
+19 SET SDECRESD=$ORDER(^SDEC(409.831,"B",SDECRES,0))
+20 IF '+SDECRESD
DO ERR2(SDECRES,"SDEC REBOOK NEXT BLOCK: Invalid resource name")
QUIT
+21 SET X=SDECDATE
SET %DT="XT"
DO ^%DT
+22 IF Y=-1
DO ERR2(1,"SDEC REBOOK NEXT BLOCK: Invalid datetime")
QUIT
+23 SET SDECDATE=$PIECE(Y,".")
+24 ;
+25 SET SDECFND=0
+26 DO GETSLOTS^SDEC04(SDAB,SDECRESD,SDECDATE,$$FMADD^XLFDT(SDECDATE,10))
+27 SET SDI=0
FOR
SET SDI=$ORDER(@SDAB@(SDI))
if SDI'>0
QUIT
Begin DoDot:1
+28 SET SDECNOD=@SDAB@(SDI)
+29 ;Slots
if +$PIECE(SDECNOD,U,4)=0
QUIT
+30 SET SDECATID=$PIECE(SDECNOD,U,5)
+31 IF SDECTPID=0!(SDECATID=SDECTPID)
SET SDECFND=$PIECE(SDECNOD,U,2)
QUIT
End DoDot:1
+32 ;
+33 IF SDECFND=0
SET SDECFND=""
+34 ;
+35 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+36 ;
+37 ;
IF '$TEST
SET SDECFND=$$FMTONET^SDECDATE(SDECFND,"Y")
+38 ;E S Y=SDECFND X ^DD("DD") S SDECFND=Y
+39 ;S SDECFND=$TR(SDECFND,"@"," ")
+40 SET SDECI=SDECI+1
+41 SET ^TMP("SDEC",$JOB,SDECI)="1^"_SDECFND_"^"_$CHAR(30)_$CHAR(31)
+42 QUIT
+43 ;
SETRBOOK(SDECY,SDECAPPT,SDECDATE) ;Sets rebook date into appointment
+1 ;SETRBOOK(SDECY,SDECAPPT,SDECDATE) external parameter tag is in SDEC
+2 ;SDECAPPT - Appointment ID
+3 ;SDECDATE - Rebook Datetime in external format
+4 ;Called by SDEC REBOOK SET
+5 ;
+6 ;ErrorID:
+7 ; 0 if a problem. Message in ERRORTEXT
+8 ; 1 if OK
+9 ;
+10 NEW SDECFDA,SDECI,SDECIENS,%DT,SDECMSG,X,Y
+11 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+12 KILL @SDECY
+13 SET SDECI=0
+14 SET ^TMP("SDEC",$JOB,SDECI)="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)
+15 ;
+16 IF '+SDECAPPT
+17 IF '$DATA(^SDEC(409.84,SDECAPPT,0))
DO ERR(1,"SDEC REBOOK SET: Invalid appointment ID")
QUIT
+18 ;
+19 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+20 ;
+21 SET SDECDATE=$$NETTOFM^SDECDATE(SDECDATE,"Y","N")
IF SDECDATE=-1
DO ERR(1,"SDEC REBOOK SET: Invalid rebook datetime")
QUIT
+22 ;S X=SDECDATE,%DT="XT" D ^%DT
+23 ;I Y=-1 D ERR(1,"SDEC REBOOK SET: Invalid rebook datetime") Q
+24 ;S SDECDATE=Y
+25 SET SDECIENS=SDECAPPT_","
+26 SET SDECFDA(409.84,SDECIENS,.11)=SDECDATE
+27 ;
+28 KILL SDECMSG
+29 DO FILE^DIE("","SDECFDA","SDECMSG")
+30 SET SDECI=SDECI+1
+31 SET ^TMP("SDEC",$JOB,SDECI)="1^"_$CHAR(31)
+32 ;
+33 QUIT
+34 ;
ERR(SDECERID,ERRTXT) ;Error processing
+1 if '+$GET(SDECI)
SET SDECI=999999
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC",$JOB,SDECI)=SDECERID_"^"_ERRTXT_$CHAR(30)
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+6 QUIT
+7 ;
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(SDECI)
NEW SDECI
SET SDECI=999999
+3 SET SDECI=SDECI+1
+4 DO ERR(0,"SDEC33 Error")
+5 QUIT
+6 ;
ERR2(SDECERID,ERRTXT) ;Error processing
+1 if '+$GET(SDECI)
SET SDECI=999999
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC",$JOB,SDECI)=SDECERID_"^^"_ERRTXT_$CHAR(30)
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+6 QUIT
+7 ;
ERROR2 ;
+1 DO ^%ZTER
+2 IF '+$GET(SDECI)
NEW SDECI
SET SDECI=999999
+3 SET SDECI=SDECI+1
+4 DO ERR2(0,"SDEC33 Error")
+5 QUIT
