SDEC04 ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016
;;5.3;Scheduling;**627,642**;Aug 13, 1993;Build 23
;
Q
;
CSLOTSCH(SDECY,SDECRES,SDECSTART,SDECEND,SDECTYPES,SDECSRCH) ;GET Create Assigned Slot Schedule
;Create Assigned Slot Schedule recordset
;This call is used both to create a schedule of availability for the calendar display
;and to search for availability in the Find Appointment function
;
;SDECRES is resource name
;
;SDECTYPES is |-delimited list of Access Type Names
;If SDECTYPES is "" then the screen passes all types.
;
;SDECSRCH is |-delimited search info for the Find Appointment function
;First piece is 1 if we are in a Find Appointment call
;Second piece is weekday info in the format MTWHFSU
;Third piece is AM PM info in the form AP
;If 2nd or 3rd pieces are null, the screen for that piece is skipped
;RETURN:
; Global Array in which each array entry contains slot data separated by ^:
; 1. START_TIME
; 2. END_TIME
; 3. SLOTS
; 4. RESOURCE
; 5. ACCESS_TYPE
; 6. NOTE
; 7. AVAILABILITYID
; 8. ACCESS_TYPE_TEXT
;
N CNT
N SDECAD,SDECALO,SDECBS,SDECDEP,SDECERR,SDECI,SDECIEN,SDECK,SDECL,SDECNEND,SDECNOD
N SDECNOT,SDECNSTART,SDECPEND,SDECQ,SDECRESD,SDECRESN,SDECS,SDECSUBCD,SDECTMP
N SDAB,SDECTYPE,SDECTYPED,SDECZ
N %DT,X,Y
K ^TMP("SDEC",$J)
S SDECERR=""
S SDECY="^TMP(""SDEC"","_$J_")"
S SDECALO=0,SDECI=0
S ^TMP("SDEC",$J,SDECI)="T00030START_TIME^T00030END_TIME^I00010SLOTS^T00030RESOURCE^T00010ACCESS_TYPE^T00250NOTE^I00030AVAILABILITYID^T00030ACCESS_TYPE_TEXT"_$C(30)
;
S %DT="T",X=$P($P(SDECSTART,"@",1),".",1) D ^%DT
S SDECSTART=Y
S %DT="T",X=$P($P(SDECEND,"@",1),".",1) D ^%DT
S SDECEND=Y
S SDECTYPES=$G(SDECTYPES)
S SDECSRCH=$G(SDECSRCH)
;validate SDECRES
S SDECRES=$G(SDECRES) I SDECRES="" S @SDECY@(1)="-1^Invalid Resource ID" Q
I +SDECRES,'$D(^SDEC(409.831,+SDECRES,0)) S @SDECY@(1)="-1^Resource ID is required" Q
I '+SDECRES S SDECRES=$O(^SDEC(409.831,"B",SDECRES,0)) I '+SDECRES S @SDECY@(1)="-1^Invalid Resource ID" Q
S SDAB="^TMP("_$J_",""SDEC"",""BLKS"")"
K @SDAB
;D GETSLOTS(SDAB,SDECRES,SDECSTART,SDECEND)
D GETSLOTS^SDEC57(SDAB,SDECRES,SDECSTART,SDECEND)
D:SDECTYPES'="" SDTYPES(.SDTYPES,SDECTYPES)
;Get Access Type IDs
I 0,'+SDECSRCH S SDECTYPED=""
I 0,+SDECSRCH F SDECK=1:1:$L(SDECTYPES,"|") D
. S SDECL=$P(SDECTYPES,"|",SDECK)
. I SDECL="" S $P(SDECTYPED,"|",SDECK)=0 Q
. I '$D(^SDEC(409.823,"B",SDECL)) S $P(SDECTYPED,"|",SDECK)=0 Q
. S $P(SDECTYPED,"|",SDECK)=$O(^SDEC(409.823,"B",SDECL,0))
;
N SD1,SD2,SD3,SD4,SDI,SDN,SDNOD
S SDI=0 F S SDI=$O(@SDAB@(SDI)) Q:SDI'>0 D
.S SDNOD=@SDAB@(SDI)
.S Y=$P(SDNOD,U,2) X ^DD("DD") S SD1=$TR(Y,"@"," ")
.S Y=$P(SDNOD,U,3) X ^DD("DD") S SD2=$TR(Y,"@"," ")
.S SD3=+$P(SDNOD,U,4)
.S SD4=$P($G(^SDEC(409.831,SDECRES,0)),U,1)
.S SDECI=SDECI+1 S @SDECY@(SDECI)=SD1_U_SD2_U_SD3_U_SD4_U_$P(SDNOD,U,5)_U_U_SDI_$C(30)
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
K @SDAB
Q
;
GETSLOTS(SDAB,SDECRES,SDECSTART,SDECEND) ;load SDEC ACCESS BLOCKS from file 44
N SDCL,SDI,SDJ
S SDECRES=$G(SDECRES) Q:SDECRES=""
I +SDECRES,'$D(^SDEC(409.831,+SDECRES,0)) Q
I '+SDECRES S SDECRES=$O(^SDEC(409.831,"B",SDECRES,0))
G:'SDECRES GETX
S %DT="T",X=$P($P(SDECSTART,"@",1),".",1) D ^%DT
G:Y=-1 GETX
S SDECSTART=Y
S %DT="T",X=$P($P(SDECEND,"@",1),".",1) D ^%DT
G:Y=-1 GETX
S SDECEND=Y
S SDCL=$$GET1^DIQ(409.831,SDECRES_",",.04,"I")
G:SDCL="" GETX
;L +^SDEC(409.831,SDECRES):5 G:'$T GETX
S SDI=$$FMADD^XLFDT(SDECSTART,-1)
F S SDI=$$FMADD^XLFDT(SDI,1) Q:SDI>$P(SDECEND,".",1) D
.I ($O(^SC(SDCL,"T",0))="")!($O(^SC(SDCL,"T",0))>SDI) Q
.I $$GET1^DIQ(44,SDCL_",",1918.5,"I")'="Y",$D(^HOLIDAY("B",SDI)) Q ;do not schedule on holidays
.Q:$$INACTIVE^SDEC32(SDCL,$P(SDI,".",1)) ;don't get availability if clinic inactive on day SDI
.;Q:$G(^SC(SDCL,"ST",SDI,1))["**CANCELLED**"
.D RESAB^SDECUTL2(SDAB,SDCL,SDI,SDI_"."_2359,SDECRES)
GETX ;
;L -^SDEC(409.831,SDECRES)
Q
;
ABM ;Maintenance routine for SDEC ACCESS BLOCK file to be scheduled nightly
Q
;
SDTYPES(SDTYPES,SDECTYPES) ;
N SDI,SDTYPE,SDTYPEN
K SDTYPES
F SDI=1:1:$L(SDECTYPES,"|") D
.S SDTYPEN=$P(SDECTYPES,"|",SDI)
.I +SDTYPEN S SDTYPE=SDTYPEN,SDTYPEN=$$GET1^DIQ(409.823,SDTYPE_",",.01)
.E S SDTYPE=$O(^SDEC(409.823,"B",$E(SDTYPEN,1,30),0))
.S:SDTYPE'="" SDTYPES(SDTYPE)=SDTYPEN
Q
;
DEL(SDRES,SDBEG,SDEND) ;delete access blocks
Q
;
NOAVAIL(SDECY,SDCL) ;GET: has the given clinic ever had any availability defined?
;SDCL = (required) Clinic ID pointer to HOSPITAL LOCATION file
;RETURN:
; 1. AVAILABILITY:
; YES = Availability has been defined for this clinic
; (even if there is no availability defined 'now')
; NO = Availability has never been defined for this clinic.
N SDECI
S SDECI=0
S SDECY="^TMP(""SDEC04"","_$J_",""NOVAVAIL"")"
K @SDECY
S @SDECY@(SDECI)="T00030AVAILABILITY"_$C(30)
;validate SDCL
S SDCL=$G(SDCL) I '$D(^SC(+SDCL,0)) S SDECI=SDECI+1 S @SDECY@(SDECI)="-1^Invalid clinic id."_$C(30,31) Q
S SDECI=SDECI+1 S @SDECY@(SDECI)=$S(+$O(^SC(SDCL,"T",0)):"YES",1:"NO")_$C(30,31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC04 5192 printed Dec 13, 2024@02:49:54 Page 2
SDEC04 ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016
+1 ;;5.3;Scheduling;**627,642**;Aug 13, 1993;Build 23
+2 ;
+3 QUIT
+4 ;
CSLOTSCH(SDECY,SDECRES,SDECSTART,SDECEND,SDECTYPES,SDECSRCH) ;GET Create Assigned Slot Schedule
+1 ;Create Assigned Slot Schedule recordset
+2 ;This call is used both to create a schedule of availability for the calendar display
+3 ;and to search for availability in the Find Appointment function
+4 ;
+5 ;SDECRES is resource name
+6 ;
+7 ;SDECTYPES is |-delimited list of Access Type Names
+8 ;If SDECTYPES is "" then the screen passes all types.
+9 ;
+10 ;SDECSRCH is |-delimited search info for the Find Appointment function
+11 ;First piece is 1 if we are in a Find Appointment call
+12 ;Second piece is weekday info in the format MTWHFSU
+13 ;Third piece is AM PM info in the form AP
+14 ;If 2nd or 3rd pieces are null, the screen for that piece is skipped
+15 ;RETURN:
+16 ; Global Array in which each array entry contains slot data separated by ^:
+17 ; 1. START_TIME
+18 ; 2. END_TIME
+19 ; 3. SLOTS
+20 ; 4. RESOURCE
+21 ; 5. ACCESS_TYPE
+22 ; 6. NOTE
+23 ; 7. AVAILABILITYID
+24 ; 8. ACCESS_TYPE_TEXT
+25 ;
+26 NEW CNT
+27 NEW SDECAD,SDECALO,SDECBS,SDECDEP,SDECERR,SDECI,SDECIEN,SDECK,SDECL,SDECNEND,SDECNOD
+28 NEW SDECNOT,SDECNSTART,SDECPEND,SDECQ,SDECRESD,SDECRESN,SDECS,SDECSUBCD,SDECTMP
+29 NEW SDAB,SDECTYPE,SDECTYPED,SDECZ
+30 NEW %DT,X,Y
+31 KILL ^TMP("SDEC",$JOB)
+32 SET SDECERR=""
+33 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+34 SET SDECALO=0
SET SDECI=0
+35 SET ^TMP("SDEC",$JOB,SDECI)="T00030START_TIME^T00030END_TIME^I00010SLOTS^T00030RESOURCE^T00010ACCESS_TYPE^T00250NOTE^I00030AVAILABILITYID^T00030ACCESS_TYPE_TEXT"_$CHAR(30)
+36 ;
+37 SET %DT="T"
SET X=$PIECE($PIECE(SDECSTART,"@",1),".",1)
DO ^%DT
+38 SET SDECSTART=Y
+39 SET %DT="T"
SET X=$PIECE($PIECE(SDECEND,"@",1),".",1)
DO ^%DT
+40 SET SDECEND=Y
+41 SET SDECTYPES=$GET(SDECTYPES)
+42 SET SDECSRCH=$GET(SDECSRCH)
+43 ;validate SDECRES
+44 SET SDECRES=$GET(SDECRES)
IF SDECRES=""
SET @SDECY@(1)="-1^Invalid Resource ID"
QUIT
+45 IF +SDECRES
IF '$DATA(^SDEC(409.831,+SDECRES,0))
SET @SDECY@(1)="-1^Resource ID is required"
QUIT
+46 IF '+SDECRES
SET SDECRES=$ORDER(^SDEC(409.831,"B",SDECRES,0))
IF '+SDECRES
SET @SDECY@(1)="-1^Invalid Resource ID"
QUIT
+47 SET SDAB="^TMP("_$JOB_",""SDEC"",""BLKS"")"
+48 KILL @SDAB
+49 ;D GETSLOTS(SDAB,SDECRES,SDECSTART,SDECEND)
+50 DO GETSLOTS^SDEC57(SDAB,SDECRES,SDECSTART,SDECEND)
+51 if SDECTYPES'=""
DO SDTYPES(.SDTYPES,SDECTYPES)
+52 ;Get Access Type IDs
+53 IF 0
IF '+SDECSRCH
SET SDECTYPED=""
+54 IF 0
IF +SDECSRCH
FOR SDECK=1:1:$LENGTH(SDECTYPES,"|")
Begin DoDot:1
+55 SET SDECL=$PIECE(SDECTYPES,"|",SDECK)
+56 IF SDECL=""
SET $PIECE(SDECTYPED,"|",SDECK)=0
QUIT
+57 IF '$DATA(^SDEC(409.823,"B",SDECL))
SET $PIECE(SDECTYPED,"|",SDECK)=0
QUIT
+58 SET $PIECE(SDECTYPED,"|",SDECK)=$ORDER(^SDEC(409.823,"B",SDECL,0))
End DoDot:1
+59 ;
+60 NEW SD1,SD2,SD3,SD4,SDI,SDN,SDNOD
+61 SET SDI=0
FOR
SET SDI=$ORDER(@SDAB@(SDI))
if SDI'>0
QUIT
Begin DoDot:1
+62 SET SDNOD=@SDAB@(SDI)
+63 SET Y=$PIECE(SDNOD,U,2)
XECUTE ^DD("DD")
SET SD1=$TRANSLATE(Y,"@"," ")
+64 SET Y=$PIECE(SDNOD,U,3)
XECUTE ^DD("DD")
SET SD2=$TRANSLATE(Y,"@"," ")
+65 SET SD3=+$PIECE(SDNOD,U,4)
+66 SET SD4=$PIECE($GET(^SDEC(409.831,SDECRES,0)),U,1)
+67 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=SD1_U_SD2_U_SD3_U_SD4_U_$PIECE(SDNOD,U,5)_U_U_SDI_$CHAR(30)
End DoDot:1
+68 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+69 KILL @SDAB
+70 QUIT
+71 ;
GETSLOTS(SDAB,SDECRES,SDECSTART,SDECEND) ;load SDEC ACCESS BLOCKS from file 44
+1 NEW SDCL,SDI,SDJ
+2 SET SDECRES=$GET(SDECRES)
if SDECRES=""
QUIT
+3 IF +SDECRES
IF '$DATA(^SDEC(409.831,+SDECRES,0))
QUIT
+4 IF '+SDECRES
SET SDECRES=$ORDER(^SDEC(409.831,"B",SDECRES,0))
+5 if 'SDECRES
GOTO GETX
+6 SET %DT="T"
SET X=$PIECE($PIECE(SDECSTART,"@",1),".",1)
DO ^%DT
+7 if Y=-1
GOTO GETX
+8 SET SDECSTART=Y
+9 SET %DT="T"
SET X=$PIECE($PIECE(SDECEND,"@",1),".",1)
DO ^%DT
+10 if Y=-1
GOTO GETX
+11 SET SDECEND=Y
+12 SET SDCL=$$GET1^DIQ(409.831,SDECRES_",",.04,"I")
+13 if SDCL=""
GOTO GETX
+14 ;L +^SDEC(409.831,SDECRES):5 G:'$T GETX
+15 SET SDI=$$FMADD^XLFDT(SDECSTART,-1)
+16 FOR
SET SDI=$$FMADD^XLFDT(SDI,1)
if SDI>$PIECE(SDECEND,".",1)
QUIT
Begin DoDot:1
+17 IF ($ORDER(^SC(SDCL,"T",0))="")!($ORDER(^SC(SDCL,"T",0))>SDI)
QUIT
+18 ;do not schedule on holidays
IF $$GET1^DIQ(44,SDCL_",",1918.5,"I")'="Y"
IF $DATA(^HOLIDAY("B",SDI))
QUIT
+19 ;don't get availability if clinic inactive on day SDI
if $$INACTIVE^SDEC32(SDCL,$PIECE(SDI,".",1))
QUIT
+20 ;Q:$G(^SC(SDCL,"ST",SDI,1))["**CANCELLED**"
+21 DO RESAB^SDECUTL2(SDAB,SDCL,SDI,SDI_"."_2359,SDECRES)
End DoDot:1
GETX ;
+1 ;L -^SDEC(409.831,SDECRES)
+2 QUIT
+3 ;
ABM ;Maintenance routine for SDEC ACCESS BLOCK file to be scheduled nightly
+1 QUIT
+2 ;
SDTYPES(SDTYPES,SDECTYPES) ;
+1 NEW SDI,SDTYPE,SDTYPEN
+2 KILL SDTYPES
+3 FOR SDI=1:1:$LENGTH(SDECTYPES,"|")
Begin DoDot:1
+4 SET SDTYPEN=$PIECE(SDECTYPES,"|",SDI)
+5 IF +SDTYPEN
SET SDTYPE=SDTYPEN
SET SDTYPEN=$$GET1^DIQ(409.823,SDTYPE_",",.01)
+6 IF '$TEST
SET SDTYPE=$ORDER(^SDEC(409.823,"B",$EXTRACT(SDTYPEN,1,30),0))
+7 if SDTYPE'=""
SET SDTYPES(SDTYPE)=SDTYPEN
End DoDot:1
+8 QUIT
+9 ;
DEL(SDRES,SDBEG,SDEND) ;delete access blocks
+1 QUIT
+2 ;
NOAVAIL(SDECY,SDCL) ;GET: has the given clinic ever had any availability defined?
+1 ;SDCL = (required) Clinic ID pointer to HOSPITAL LOCATION file
+2 ;RETURN:
+3 ; 1. AVAILABILITY:
+4 ; YES = Availability has been defined for this clinic
+5 ; (even if there is no availability defined 'now')
+6 ; NO = Availability has never been defined for this clinic.
+7 NEW SDECI
+8 SET SDECI=0
+9 SET SDECY="^TMP(""SDEC04"","_$JOB_",""NOVAVAIL"")"
+10 KILL @SDECY
+11 SET @SDECY@(SDECI)="T00030AVAILABILITY"_$CHAR(30)
+12 ;validate SDCL
+13 SET SDCL=$GET(SDCL)
IF '$DATA(^SC(+SDCL,0))
SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^Invalid clinic id."_$CHAR(30,31)
QUIT
+14 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=$SELECT(+$ORDER(^SC(SDCL,"T",0)):"YES",1:"NO")_$CHAR(30,31)
+15 QUIT
