SDEC06 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
;
Q
;
TPBLKOV(SDECY,SDECSTART,SDECEND,SDECRES) ;TYPE BLOCKS OVERLAP
;TPBLKOV(SDECY,SDECSTART,SDECEND,SDECRES) external parameter tag in SDEC
;SDECSTART - Start date/time in external format
;SDECEND - End date/time in external format
;SDECRES - Resource name from the NAME field of the SDEC RESOURCE file
;SDECRES is resource name
;RETURN:
;Returns a Global Array in which each array entry contains data Access Block data separated by ^:
; 1. StartTime
; 2. EndTime
; 3. AppointmentTypeID
; 4. AvailabilityID
; 5. ResourceName
N SDAB,SDECERR,SDECIEN,SDECDEP,SDECBS,SDECI,SDECNEND,SDECNSTART,SDECPEND,SDECRESD,SDECRESN,SDECS,SDECTPID,SDECNOD,SDECAD
N %DT,X,Y
S SDAB="^TMP("_$J_",""SDEC"",""BLKS"")"
K @SDAB
K ^TMP("SDEC",$J)
S SDECERR=""
S SDECY="^TMP(""SDEC"","_$J_")",SDECI=0
S ^TMP("SDEC",$J,SDECI)="D00030StartTime^D00030EndTime^I00010AppointmentTypeID^I00010AvailabilityID^T00030ResourceName"_$C(30)
D
. S SDECBS=0
. ;
. ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. ;
. S SDECSTART=$$NETTOFM^SDECDATE(SDECSTART,"Y","Y") I SDECSTART=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
. ;S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@")
. ;S:SDECEND["@0000" SDECEND=$P(SDECEND,"@")
. ;S %DT="T",X=SDECSTART D ^%DT S SDECSTART=Y
. ;I SDECSTART=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
. S SDECEND=$$NETTOFM^SDECDATE(SDECEND,"Y","Y") I SDECSTART=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
. ;S %DT="T",X=SDECEND D ^%DT S SDECEND=Y
. ;I SDECEND=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
. I $L(SDECEND,".")=1 S SDECEND=SDECEND+.9999 ;Go to end of day
. S SDECRESN=SDECRES
. Q:SDECRESN=""
. I +SDECRESN S SDECRESD=SDECRESN,SDECRESN=$P($G(^SDEC(409.831,+SDECRESN,0)),U,1)
. E S SDECRESD=$O(^SDEC(409.831,"B",SDECRESN,0))
. I ('+SDECRESD)!('$D(^SDEC(409.831,+SDECRESD,0))) Q
. D GETSLOTS^SDEC04(SDAB,SDECRESD,SDECSTART,SDECEND)
. D STCOMM(SDECRESN,SDECRESD,SDAB)
. Q
;
S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)
K @SDAB
Q
;
STCOMM(SDECRESN,SDECRESD,SDAB) ;EP
;
S SDECNEND=0,SDECNSTART=0,SDECPEND=0
;
N SDI
S SDI=0 F S SDI=$O(@SDAB@(SDI)) Q:SDI'>0 D
.S SDECNOD=@SDAB@(SDI)
.S SDECNSTART=$P(SDECNOD,U,2)
.S SDECNEND=$P(SDECNOD,U,3)
.I SDECNEND'>SDECSTART Q
. ;
. ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
. ;
. S SDECNSTART=$$FMTONET^SDECDATE(SDECNSTART,"Y") ;
. ;S Y=SDECNSTART X ^DD("DD") S SDECNSTART=$TR(Y,"@"," ")
. S SDECNEND=$$FMTONET^SDECDATE(SDECNEND,"Y") ;
. ;S Y=SDECNEND X ^DD("DD") S SDECNEND=$TR(Y,"@"," ")
.S SDECTPID=$P(SDECNOD,U,5)
.S SDECI=SDECI+1
.S ^TMP("SDEC",$J,SDECI)=SDECNSTART_U_SDECNEND_U_+SDECTPID_U_SDI_U_SDECRESN_$C(30)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC06 2849 printed Dec 13, 2024@02:49:56 Page 2
SDEC06 ;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 ;
TPBLKOV(SDECY,SDECSTART,SDECEND,SDECRES) ;TYPE BLOCKS OVERLAP
+1 ;TPBLKOV(SDECY,SDECSTART,SDECEND,SDECRES) external parameter tag in SDEC
+2 ;SDECSTART - Start date/time in external format
+3 ;SDECEND - End date/time in external format
+4 ;SDECRES - Resource name from the NAME field of the SDEC RESOURCE file
+5 ;SDECRES is resource name
+6 ;RETURN:
+7 ;Returns a Global Array in which each array entry contains data Access Block data separated by ^:
+8 ; 1. StartTime
+9 ; 2. EndTime
+10 ; 3. AppointmentTypeID
+11 ; 4. AvailabilityID
+12 ; 5. ResourceName
+13 NEW SDAB,SDECERR,SDECIEN,SDECDEP,SDECBS,SDECI,SDECNEND,SDECNSTART,SDECPEND,SDECRESD,SDECRESN,SDECS,SDECTPID,SDECNOD,SDECAD
+14 NEW %DT,X,Y
+15 SET SDAB="^TMP("_$JOB_",""SDEC"",""BLKS"")"
+16 KILL @SDAB
+17 KILL ^TMP("SDEC",$JOB)
+18 SET SDECERR=""
+19 SET SDECY="^TMP(""SDEC"","_$JOB_")"
SET SDECI=0
+20 SET ^TMP("SDEC",$JOB,SDECI)="D00030StartTime^D00030EndTime^I00010AppointmentTypeID^I00010AvailabilityID^T00030ResourceName"_$CHAR(30)
+21 Begin DoDot:1
+22 SET SDECBS=0
+23 ;
+24 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+25 ;
+26 SET SDECSTART=$$NETTOFM^SDECDATE(SDECSTART,"Y","Y")
IF SDECSTART=-1
SET ^TMP("SDEC",$JOB,1)=$CHAR(31)
QUIT
+27 ;S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@")
+28 ;S:SDECEND["@0000" SDECEND=$P(SDECEND,"@")
+29 ;S %DT="T",X=SDECSTART D ^%DT S SDECSTART=Y
+30 ;I SDECSTART=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
+31 SET SDECEND=$$NETTOFM^SDECDATE(SDECEND,"Y","Y")
IF SDECSTART=-1
SET ^TMP("SDEC",$JOB,1)=$CHAR(31)
QUIT
+32 ;S %DT="T",X=SDECEND D ^%DT S SDECEND=Y
+33 ;I SDECEND=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
+34 ;Go to end of day
IF $LENGTH(SDECEND,".")=1
SET SDECEND=SDECEND+.9999
+35 SET SDECRESN=SDECRES
+36 if SDECRESN=""
QUIT
+37 IF +SDECRESN
SET SDECRESD=SDECRESN
SET SDECRESN=$PIECE($GET(^SDEC(409.831,+SDECRESN,0)),U,1)
+38 IF '$TEST
SET SDECRESD=$ORDER(^SDEC(409.831,"B",SDECRESN,0))
+39 IF ('+SDECRESD)!('$DATA(^SDEC(409.831,+SDECRESD,0)))
QUIT
+40 DO GETSLOTS^SDEC04(SDAB,SDECRESD,SDECSTART,SDECEND)
+41 DO STCOMM(SDECRESN,SDECRESD,SDAB)
+42 QUIT
End DoDot:1
+43 ;
+44 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_$CHAR(31)
+45 KILL @SDAB
+46 QUIT
+47 ;
STCOMM(SDECRESN,SDECRESD,SDAB) ;EP
+1 ;
+2 SET SDECNEND=0
SET SDECNSTART=0
SET SDECPEND=0
+3 ;
+4 NEW SDI
+5 SET SDI=0
FOR
SET SDI=$ORDER(@SDAB@(SDI))
if SDI'>0
QUIT
Begin DoDot:1
+6 SET SDECNOD=@SDAB@(SDI)
+7 SET SDECNSTART=$PIECE(SDECNOD,U,2)
+8 SET SDECNEND=$PIECE(SDECNOD,U,3)
+9 IF SDECNEND'>SDECSTART
QUIT
+10 ;
+11 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+12 ;
+13 ;
SET SDECNSTART=$$FMTONET^SDECDATE(SDECNSTART,"Y")
+14 ;S Y=SDECNSTART X ^DD("DD") S SDECNSTART=$TR(Y,"@"," ")
+15 ;
SET SDECNEND=$$FMTONET^SDECDATE(SDECNEND,"Y")
+16 ;S Y=SDECNEND X ^DD("DD") S SDECNEND=$TR(Y,"@"," ")
+17 SET SDECTPID=$PIECE(SDECNOD,U,5)
+18 SET SDECI=SDECI+1
+19 SET ^TMP("SDEC",$JOB,SDECI)=SDECNSTART_U_SDECNEND_U_+SDECTPID_U_SDI_U_SDECRESN_$CHAR(30)
End DoDot:1
+20 QUIT
