Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDMANA

SDMANA.m

Go to the documentation of this file. 
  1. SDMANA ;BP-CIOFO/KEITH - Make Appointment 'Next Available' functionality ; 30 Nov 99  2:38 PM
  1.  ;;5.3;Scheduling;**206,1015**;AUG 13, 1993;Build 21
  1.  ;
  1.  ;Input: SC=clinic ifn
  1.  ;Input: SDT=date of appointment being scheduled
  1.  ;Input: SDUR=User response (optional)
  1.  ;            'N' for user defined 'next available' scheduling request
  1.  ;            'C' other than 'next available' at clinician request
  1.  ;            'P' other than 'next available' at patient request
  1.  ;            'W' for walkin (unscheduled) appointment
  1.  ;            'M' for multiple appointment booking
  1.  ;            'A' for auto rebook
  1.  ;
  1.  ;Output: '0' = not defined or computed to be a 'next available' appt.
  1.  ;        '1' = user defined 'next available' scheduling request
  1.  ;        '2' = computed to be a 'next available' appointment
  1.  ;        '3' = user defined and computed to be 'next available' appt.
  1.  ;
  1.  N SD,SDAY,SDOUT,SDIND
  1.  ;Initialize variables
  1.  S SDUR=$G(SDUR),SDT=SDT\1,(SDOUT,SDIND)=0 D INIT
  1.  I SC'>0!'SDT!(SDT<DT) Q SDIND  ;Check input variables
  1.  S SDAY=DT F  D  Q:SDOUT
  1.  .I $$PCNT($$PAT(SC,SDAY)) S SDOUT=1,SDIND=$$IND(SDT,SDAY,SDUR) Q
  1.  .S SDAY=$$FMADD^XLFDT(SDAY,1)  ;Increment days
  1.  .I SDAY>SDT S SDOUT=1,SDIND=$$IND(SDT,SDAY,SDUR)
  1.  .Q
  1.  Q SDIND
  1.  ;
  1. IND(SDT,SDAY,SDUR) ;Compute indicator
  1.  ;Input/Output: as described in NAVA entry point
  1.  Q $S(SDAY=SDT:2,1:0)+$S(SDUR="N":1,1:0)
  1.  ;
  1. PAT(SC,SDT) ;Return pattern for specified date (modified clone of OVR^SDAUT1)
  1.  ;Input: SC=clinic ifn
  1.  ;Input: SDT=date of pattern
  1.  ;Output: Current availability pattern for date selected
  1.  ;        in the format of ^SC(clinic,"ST",date,1) nodes
  1.  ;
  1.  N SDI,SDIN,SDRE,SDSOH,SDD,SDJ,SDY,SDS,SDAY
  1.  S SDT=SDT\1
  1.  ;Inactivate/reactivate dates
  1.  S SDIN=$G(^SC(SC,"I")),SDRE=$P(SDIN,U,2),SDIN=$P(SDIN,U)
  1.  I '$$ACTIVE(SDT,SDIN,SDRE) Q ""  ;Quit if not active on this date
  1.  S SDAY="SU^MO^TU^WE^TH^FR^SA" ;Day abbreviations
  1.  S SDI=$P($G(^SC(SC,"SL")),U,6),SDI=$S(SDI<3:4,1:SDI) ;Increments/hour
  1.  ;Schedule on holidays?
  1.  S SDSOH=$S('$D(^SC(SC,"SL")):0,$P(^SC(SC,"SL"),"^",8)']"":0,1:1)
  1.  Q:$O(^SC(SC,"T",0))>SDT ""  ;Earlier than first availability date
  1.  S SDD=$$DOW^XLFDT(SDT,1)  ;Day of week
  1.  K SDJ F SDY=0:1:6 I $D(^SC(+SC,"T"_SDY)) S SDJ(SDY)=""  ;Patterns
  1.  I $D(^SC(+SC,"ST",SDT,1)) Q ^SC(+SC,"ST",SDT,1)  ;Current availability
  1.  ;No ava. on file, quit if no pattern
  1.  I '$D(^SC(SC,"ST",SDT,1)) S SDY=SDD#7 Q:'$D(SDJ(SDY)) ""
  1.  ;Quit if holiday and no schedule
  1.  Q:$D(^HOLIDAY(SDT))&('SDSOH) "   "_$E(SDT,6,7)_"    "_$P(^(SDT,0),U,2)
  1.  ;Create availability string, quit if no pattern
  1.  S SDS=$O(^SC(SC,"T"_SDY,SDT)) Q:SDS<1 ""
  1.  Q:(^SC(SC,"T"_SDY,SDS,1)="") ""
  1.  Q $P(SDAY,U,SDY+1)_" "_$E(SDT,6,7)_$J("",SDI+SDI-6)_^SC(SC,"T"_SDY,SDS,1)
  1.  ;
  1. ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
  1.  ;Input: X=date to be examined
  1.  ;Input: SDIN=clinic inactive date
  1.  ;Input: SDRE=clinic reactivate date
  1.  ;Output: '1'=active, '0'=inactive
  1.  Q:'SDIN 1  Q:X<SDIN 1  Q:'SDRE 0  Q:X<SDRE 0  Q 1
  1.  ;
  1. INIT ;Initialize array for counting patterns
  1.  K SD N SDI
  1.  S SD="123456789jklmnopqrstuvwxyz"
  1.  F I=1:1:26 S SD($E(SD,I))=I
  1.  Q
  1.  ;
  1. PCNT(X) ;Count open slots in a pattern
  1.  ;Input: X=clinic availability pattern
  1.  ;Output: number of open slots in a single date pattern
  1.  N I,CT
  1.  S CT=0 Q:X'["[" CT
  1.  S X=$E(X,6,999),X=$TR(X,"|[] ","")
  1.  F I=1:1:$L(X) S CT=CT+$G(SD($E(X,I)))
  1.  Q CT