SDEC24 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
SEARCHAV(SDECY,SDECRES,SDECSTRT,SDECEND,SDECTYPES,SDECAMPM,SDECWKDY) ;Searches availability database
;SEARCHAV(SDECY,SDECRES,SDECSTRT,SDECEND,SDECTYPES,SDECAMPM,SDECWKDY) external parameter tag is in SDEC
;Searches availability database for availability blocks between
; SDECSTRT and SDECEND for each of the resources in SDECRES.
;The av blocks must be one of the types in SDECTYPES, must be
;AM or PM depending on value in SDECAMPM and
;must be on one of the weekdays listed in SDECWKDY.
;
;Return recordset containing the start times of availability blocks
;meeting the search criteria.
;
;Variables:
;SDECRES |-Delimited list of resource names
;SDECSTRT FM-formatted beginning date of search
;SDECEND FM-Formatted ending date of search
;SDECTYPES |-Delimited list of access type IENs
;SDECAMPM "AM" for am-only, "PM" for pm-only, "BOTH" for both
;SDECWKDY "" if any weekday, else |-delimited list of weekdays
;
;NOTE: If SDECEND="" Then:
; either ONE record is returned matching the first available block
; -or- NO record is returned indicating no available block exists
;
N %DT,SDEC,X,Y
S X=SDECSTRT,%DT="X" D ^%DT S SDECSTRT=$P(Y,".")
S:+SDECSTRT<0 SDECSTRT=DT
S X=SDECEND,%DT="X" D ^%DT S SDECEND=$P(Y,".")
S:+SDECEND<0 SDECEND=9990101
S SDECEND=SDECEND_".99"
N SDECRESN,SDECRESD,SDECDATE,SDECI,SDECABD,SDECNOD,SDECATD,SDECATN
N SDAB,SDECTYPE
S SDAB="^TMP("_$J_",""SDEC"",""BLKS"")"
K @SDAB
;
;Set up access types array
F SDEC=1:1:$L(SDECTYPES,"|") D
. S SDECATD=$P(SDECTYPES,"|",SDEC)
. S:+SDECATD SDEC(409.823,SDECATD)=""
;
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="T00030RESOURCENAME^D00030DATE^T00030ACCESSTYPE^T00030COMMENT"_$C(30)
F SDEC=1:1:$L(SDECRES,"|") S SDECRESN=$P(SDECRES,"|",SDEC) D
. Q:'$D(^SDEC(409.831,"B",SDECRESN))
. S SDECRESD=$O(^SDEC(409.831,"B",SDECRESN,0))
. Q:'+SDECRESD
. Q:'$D(^SDEC(409.831,SDECRESD,0))
. D GETSLOTS^SDEC04(SDAB,SDECRESD,SDECSTRT,SDECEND)
. Q:'$O(@SDAB@(0)) ;$D(^SDEC(409.821,"ARSCT",SDECRESD))
. S SDECNOD=@SDAB@(1)
. S SDECDATE=$P(SDECNOD,U,2) ;$O(^SDEC(409.821,"ARSCT",SDECRESD,SDECSTRT))
. Q:SDECDATE=""
. Q:SDECDATE>SDECEND
. ;TODO: Screen for AMPM
. ;TODO: Screen for Weekday
. ;
. S SDECI=SDECI+1
. ;S SDECABD=$O(^SDEC(409.821,"ARSCT",SDECRESD,SDECDATE,0))
. ;S SDECNOD=$G(^SDEC(409.821,SDECABD,0))
. Q:SDECNOD=""
. S Y=$P(SDECDATE,".")
. D DD^%DT
. S SDECATD=$P(SDECNOD,U,5) ;ACCESS TYPE POINTER
. S SDECATD=$G(^SDEC(409.823,+SDECATD,0))
. S SDECATN=$P(SDECATD,U)
. I +SDECATD,SDECTYPES]"" Q:'$D(SDEC(409.823,SDECATD))
. ;TODO: Screen for TYPE ----DONE!
. ;TODO: Comment
. S ^TMP("SDEC",$J,SDECI)=SDECRESN_U_Y_U_SDECATN_U_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC24 2938 printed Nov 22, 2024@18:00:17 Page 2
SDEC24 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
SEARCHAV(SDECY,SDECRES,SDECSTRT,SDECEND,SDECTYPES,SDECAMPM,SDECWKDY) ;Searches availability database
+1 ;SEARCHAV(SDECY,SDECRES,SDECSTRT,SDECEND,SDECTYPES,SDECAMPM,SDECWKDY) external parameter tag is in SDEC
+2 ;Searches availability database for availability blocks between
+3 ; SDECSTRT and SDECEND for each of the resources in SDECRES.
+4 ;The av blocks must be one of the types in SDECTYPES, must be
+5 ;AM or PM depending on value in SDECAMPM and
+6 ;must be on one of the weekdays listed in SDECWKDY.
+7 ;
+8 ;Return recordset containing the start times of availability blocks
+9 ;meeting the search criteria.
+10 ;
+11 ;Variables:
+12 ;SDECRES |-Delimited list of resource names
+13 ;SDECSTRT FM-formatted beginning date of search
+14 ;SDECEND FM-Formatted ending date of search
+15 ;SDECTYPES |-Delimited list of access type IENs
+16 ;SDECAMPM "AM" for am-only, "PM" for pm-only, "BOTH" for both
+17 ;SDECWKDY "" if any weekday, else |-delimited list of weekdays
+18 ;
+19 ;NOTE: If SDECEND="" Then:
+20 ; either ONE record is returned matching the first available block
+21 ; -or- NO record is returned indicating no available block exists
+22 ;
+23 NEW %DT,SDEC,X,Y
+24 SET X=SDECSTRT
SET %DT="X"
DO ^%DT
SET SDECSTRT=$PIECE(Y,".")
+25 if +SDECSTRT<0
SET SDECSTRT=DT
+26 SET X=SDECEND
SET %DT="X"
DO ^%DT
SET SDECEND=$PIECE(Y,".")
+27 if +SDECEND<0
SET SDECEND=9990101
+28 SET SDECEND=SDECEND_".99"
+29 NEW SDECRESN,SDECRESD,SDECDATE,SDECI,SDECABD,SDECNOD,SDECATD,SDECATN
+30 NEW SDAB,SDECTYPE
+31 SET SDAB="^TMP("_$JOB_",""SDEC"",""BLKS"")"
+32 KILL @SDAB
+33 ;
+34 ;Set up access types array
+35 FOR SDEC=1:1:$LENGTH(SDECTYPES,"|")
Begin DoDot:1
+36 SET SDECATD=$PIECE(SDECTYPES,"|",SDEC)
+37 if +SDECATD
SET SDEC(409.823,SDECATD)=""
End DoDot:1
+38 ;
+39 SET SDECI=0
+40 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+41 KILL @SDECY
+42 SET ^TMP("SDEC",$JOB,0)="T00030RESOURCENAME^D00030DATE^T00030ACCESSTYPE^T00030COMMENT"_$CHAR(30)
+43 FOR SDEC=1:1:$LENGTH(SDECRES,"|")
SET SDECRESN=$PIECE(SDECRES,"|",SDEC)
Begin DoDot:1
+44 if '$DATA(^SDEC(409.831,"B",SDECRESN))
QUIT
+45 SET SDECRESD=$ORDER(^SDEC(409.831,"B",SDECRESN,0))
+46 if '+SDECRESD
QUIT
+47 if '$DATA(^SDEC(409.831,SDECRESD,0))
QUIT
+48 DO GETSLOTS^SDEC04(SDAB,SDECRESD,SDECSTRT,SDECEND)
+49 ;$D(^SDEC(409.821,"ARSCT",SDECRESD))
if '$ORDER(@SDAB@(0))
QUIT
+50 SET SDECNOD=@SDAB@(1)
+51 ;$O(^SDEC(409.821,"ARSCT",SDECRESD,SDECSTRT))
SET SDECDATE=$PIECE(SDECNOD,U,2)
+52 if SDECDATE=""
QUIT
+53 if SDECDATE>SDECEND
QUIT
+54 ;TODO: Screen for AMPM
+55 ;TODO: Screen for Weekday
+56 ;
+57 SET SDECI=SDECI+1
+58 ;S SDECABD=$O(^SDEC(409.821,"ARSCT",SDECRESD,SDECDATE,0))
+59 ;S SDECNOD=$G(^SDEC(409.821,SDECABD,0))
+60 if SDECNOD=""
QUIT
+61 SET Y=$PIECE(SDECDATE,".")
+62 DO DD^%DT
+63 ;ACCESS TYPE POINTER
SET SDECATD=$PIECE(SDECNOD,U,5)
+64 SET SDECATD=$GET(^SDEC(409.823,+SDECATD,0))
+65 SET SDECATN=$PIECE(SDECATD,U)
+66 IF +SDECATD
IF SDECTYPES]""
if '$DATA(SDEC(409.823,SDECATD))
QUIT
+67 ;TODO: Screen for TYPE ----DONE!
+68 ;TODO: Comment
+69 SET ^TMP("SDEC",$JOB,SDECI)=SDECRESN_U_Y_U_SDECATN_U_$CHAR(30)
End DoDot:1
+70 SET SDECI=SDECI+1
+71 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+72 QUIT
