SDEC33.m

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 ---SDEC33   3750     printed  Mar 13, 2025@21:55:30                                                                                                                                                                                                      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