SDMANA ;BP-CIOFO/KEITH - Make Appointment 'Next Available' functionality ; 30 Nov 99 2:38 PM
;;5.3;Scheduling;**206**;AUG 13, 1993
;
NAVA(SC,SDT,SDUR) ;Compute 'next available' indicator
;Input: SC=clinic ifn
;Input: SDT=date of appointment being scheduled
;Input: SDUR=User response (optional)
; 'N' for user defined 'next available' scheduling request
; 'C' other than 'next available' at clinician request
; 'P' other than 'next available' at patient request
; 'W' for walkin (unscheduled) appointment
; 'M' for multiple appointment booking
; 'A' for auto rebook
;
;Output: '0' = not defined or computed to be a 'next available' appt.
; '1' = user defined 'next available' scheduling request
; '2' = computed to be a 'next available' appointment
; '3' = user defined and computed to be 'next available' appt.
;
N SD,SDAY,SDOUT,SDIND
;Initialize variables
S SDUR=$G(SDUR),SDT=SDT\1,(SDOUT,SDIND)=0 D INIT
I SC'>0!'SDT!(SDT<DT) Q SDIND ;Check input variables
S SDAY=DT F D Q:SDOUT
.I $$PCNT($$PAT(SC,SDAY)) S SDOUT=1,SDIND=$$IND(SDT,SDAY,SDUR) Q
.S SDAY=$$FMADD^XLFDT(SDAY,1) ;Increment days
.I SDAY>SDT S SDOUT=1,SDIND=$$IND(SDT,SDAY,SDUR)
.Q
Q SDIND
;
IND(SDT,SDAY,SDUR) ;Compute indicator
;Input/Output: as described in NAVA entry point
Q $S(SDAY=SDT:2,1:0)+$S(SDUR="N":1,1:0)
;
PAT(SC,SDT) ;Return pattern for specified date (modified clone of OVR^SDAUT1)
;Input: SC=clinic ifn
;Input: SDT=date of pattern
;Output: Current availability pattern for date selected
; in the format of ^SC(clinic,"ST",date,1) nodes
;
N SDI,SDIN,SDRE,SDSOH,SDD,SDJ,SDY,SDS,SDAY
S SDT=SDT\1
;Inactivate/reactivate dates
S SDIN=$G(^SC(SC,"I")),SDRE=$P(SDIN,U,2),SDIN=$P(SDIN,U)
I '$$ACTIVE(SDT,SDIN,SDRE) Q "" ;Quit if not active on this date
S SDAY="SU^MO^TU^WE^TH^FR^SA" ;Day abbreviations
S SDI=$P($G(^SC(SC,"SL")),U,6),SDI=$S(SDI<3:4,1:SDI) ;Increments/hour
;Schedule on holidays?
S SDSOH=$S('$D(^SC(SC,"SL")):0,$P(^SC(SC,"SL"),"^",8)']"":0,1:1)
Q:$O(^SC(SC,"T",0))>SDT "" ;Earlier than first availability date
S SDD=$$DOW^XLFDT(SDT,1) ;Day of week
K SDJ F SDY=0:1:6 I $D(^SC(+SC,"T"_SDY)) S SDJ(SDY)="" ;Patterns
I $D(^SC(+SC,"ST",SDT,1)) Q ^SC(+SC,"ST",SDT,1) ;Current availability
;No ava. on file, quit if no pattern
I '$D(^SC(SC,"ST",SDT,1)) S SDY=SDD#7 Q:'$D(SDJ(SDY)) ""
;Quit if holiday and no schedule
Q:$D(^HOLIDAY(SDT))&('SDSOH) " "_$E(SDT,6,7)_" "_$P(^(SDT,0),U,2)
;Create availability string, quit if no pattern
S SDS=$O(^SC(SC,"T"_SDY,SDT)) Q:SDS<1 ""
Q:(^SC(SC,"T"_SDY,SDS,1)="") ""
Q $P(SDAY,U,SDY+1)_" "_$E(SDT,6,7)_$J("",SDI+SDI-6)_^SC(SC,"T"_SDY,SDS,1)
;
ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
;Input: X=date to be examined
;Input: SDIN=clinic inactive date
;Input: SDRE=clinic reactivate date
;Output: '1'=active, '0'=inactive
Q:'SDIN 1 Q:X<SDIN 1 Q:'SDRE 0 Q:X<SDRE 0 Q 1
;
INIT ;Initialize array for counting patterns
K SD N SDI
S SD="123456789jklmnopqrstuvwxyz"
F I=1:1:26 S SD($E(SD,I))=I
Q
;
PCNT(X) ;Count open slots in a pattern
;Input: X=clinic availability pattern
;Output: number of open slots in a single date pattern
N I,CT
S CT=0 Q:X'["[" CT
S X=$E(X,6,999),X=$TR(X,"|[] ","")
F I=1:1:$L(X) S CT=CT+$G(SD($E(X,I)))
Q CT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDMANA 3442 printed Dec 13, 2024@02:58:33 Page 2
SDMANA ;BP-CIOFO/KEITH - Make Appointment 'Next Available' functionality ; 30 Nov 99 2:38 PM
+1 ;;5.3;Scheduling;**206**;AUG 13, 1993
+2 ;
NAVA(SC,SDT,SDUR) ;Compute 'next available' indicator
+1 ;Input: SC=clinic ifn
+2 ;Input: SDT=date of appointment being scheduled
+3 ;Input: SDUR=User response (optional)
+4 ; 'N' for user defined 'next available' scheduling request
+5 ; 'C' other than 'next available' at clinician request
+6 ; 'P' other than 'next available' at patient request
+7 ; 'W' for walkin (unscheduled) appointment
+8 ; 'M' for multiple appointment booking
+9 ; 'A' for auto rebook
+10 ;
+11 ;Output: '0' = not defined or computed to be a 'next available' appt.
+12 ; '1' = user defined 'next available' scheduling request
+13 ; '2' = computed to be a 'next available' appointment
+14 ; '3' = user defined and computed to be 'next available' appt.
+15 ;
+16 NEW SD,SDAY,SDOUT,SDIND
+17 ;Initialize variables
+18 SET SDUR=$GET(SDUR)
SET SDT=SDT\1
SET (SDOUT,SDIND)=0
DO INIT
+19 ;Check input variables
IF SC'>0!'SDT!(SDT<DT)
QUIT SDIND
+20 SET SDAY=DT
FOR
Begin DoDot:1
+21 IF $$PCNT($$PAT(SC,SDAY))
SET SDOUT=1
SET SDIND=$$IND(SDT,SDAY,SDUR)
QUIT
+22 ;Increment days
SET SDAY=$$FMADD^XLFDT(SDAY,1)
+23 IF SDAY>SDT
SET SDOUT=1
SET SDIND=$$IND(SDT,SDAY,SDUR)
+24 QUIT
End DoDot:1
if SDOUT
QUIT
+25 QUIT SDIND
+26 ;
IND(SDT,SDAY,SDUR) ;Compute indicator
+1 ;Input/Output: as described in NAVA entry point
+2 QUIT $SELECT(SDAY=SDT:2,1:0)+$SELECT(SDUR="N":1,1:0)
+3 ;
PAT(SC,SDT) ;Return pattern for specified date (modified clone of OVR^SDAUT1)
+1 ;Input: SC=clinic ifn
+2 ;Input: SDT=date of pattern
+3 ;Output: Current availability pattern for date selected
+4 ; in the format of ^SC(clinic,"ST",date,1) nodes
+5 ;
+6 NEW SDI,SDIN,SDRE,SDSOH,SDD,SDJ,SDY,SDS,SDAY
+7 SET SDT=SDT\1
+8 ;Inactivate/reactivate dates
+9 SET SDIN=$GET(^SC(SC,"I"))
SET SDRE=$PIECE(SDIN,U,2)
SET SDIN=$PIECE(SDIN,U)
+10 ;Quit if not active on this date
IF '$$ACTIVE(SDT,SDIN,SDRE)
QUIT ""
+11 ;Day abbreviations
SET SDAY="SU^MO^TU^WE^TH^FR^SA"
+12 ;Increments/hour
SET SDI=$PIECE($GET(^SC(SC,"SL")),U,6)
SET SDI=$SELECT(SDI<3:4,1:SDI)
+13 ;Schedule on holidays?
+14 SET SDSOH=$SELECT('$DATA(^SC(SC,"SL")):0,$PIECE(^SC(SC,"SL"),"^",8)']"":0,1:1)
+15 ;Earlier than first availability date
if $ORDER(^SC(SC,"T",0))>SDT
QUIT ""
+16 ;Day of week
SET SDD=$$DOW^XLFDT(SDT,1)
+17 ;Patterns
KILL SDJ
FOR SDY=0:1:6
IF $DATA(^SC(+SC,"T"_SDY))
SET SDJ(SDY)=""
+18 ;Current availability
IF $DATA(^SC(+SC,"ST",SDT,1))
QUIT ^SC(+SC,"ST",SDT,1)
+19 ;No ava. on file, quit if no pattern
+20 IF '$DATA(^SC(SC,"ST",SDT,1))
SET SDY=SDD#7
if '$DATA(SDJ(SDY))
QUIT ""
+21 ;Quit if holiday and no schedule
+22 if $DATA(^HOLIDAY(SDT))&('SDSOH)
QUIT " "_$EXTRACT(SDT,6,7)_" "_$PIECE(^(SDT,0),U,2)
+23 ;Create availability string, quit if no pattern
+24 SET SDS=$ORDER(^SC(SC,"T"_SDY,SDT))
if SDS<1
QUIT ""
+25 if (^SC(SC,"T"_SDY,SDS,1)="")
QUIT ""
+26 QUIT $PIECE(SDAY,U,SDY+1)_" "_$EXTRACT(SDT,6,7)_$JUSTIFY("",SDI+SDI-6)_^SC(SC,"T"_SDY,SDS,1)
+27 ;
ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
+1 ;Input: X=date to be examined
+2 ;Input: SDIN=clinic inactive date
+3 ;Input: SDRE=clinic reactivate date
+4 ;Output: '1'=active, '0'=inactive
+5 if 'SDIN
QUIT 1
if X<SDIN
QUIT 1
if 'SDRE
QUIT 0
if X<SDRE
QUIT 0
QUIT 1
+6 ;
INIT ;Initialize array for counting patterns
+1 KILL SD
NEW SDI
+2 SET SD="123456789jklmnopqrstuvwxyz"
+3 FOR I=1:1:26
SET SD($EXTRACT(SD,I))=I
+4 QUIT
+5 ;
PCNT(X) ;Count open slots in a pattern
+1 ;Input: X=clinic availability pattern
+2 ;Output: number of open slots in a single date pattern
+3 NEW I,CT
+4 SET CT=0
if X'["["
QUIT CT
+5 SET X=$EXTRACT(X,6,999)
SET X=$TRANSLATE(X,"|[] ","")
+6 FOR I=1:1:$LENGTH(X)
SET CT=CT+$GET(SD($EXTRACT(X,I)))
+7 QUIT CT
