- 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 Jan 18, 2025@03:51:25 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