source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDMANA.m@ 736

Last change on this file since 736 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1SDMANA ;BP-CIOFO/KEITH - Make Appointment 'Next Available' functionality ; 30 Nov 99 2:38 PM
2 ;;5.3;Scheduling;**206**;AUG 13, 1993
3 ;
4NAVA(SC,SDT,SDUR) ;Compute 'next available' indicator
5 ;Input: SC=clinic ifn
6 ;Input: SDT=date of appointment being scheduled
7 ;Input: SDUR=User response (optional)
8 ; 'N' for user defined 'next available' scheduling request
9 ; 'C' other than 'next available' at clinician request
10 ; 'P' other than 'next available' at patient request
11 ; 'W' for walkin (unscheduled) appointment
12 ; 'M' for multiple appointment booking
13 ; 'A' for auto rebook
14 ;
15 ;Output: '0' = not defined or computed to be a 'next available' appt.
16 ; '1' = user defined 'next available' scheduling request
17 ; '2' = computed to be a 'next available' appointment
18 ; '3' = user defined and computed to be 'next available' appt.
19 ;
20 N SD,SDAY,SDOUT,SDIND
21 ;Initialize variables
22 S SDUR=$G(SDUR),SDT=SDT\1,(SDOUT,SDIND)=0 D INIT
23 I SC'>0!'SDT!(SDT<DT) Q SDIND ;Check input variables
24 S SDAY=DT F D Q:SDOUT
25 .I $$PCNT($$PAT(SC,SDAY)) S SDOUT=1,SDIND=$$IND(SDT,SDAY,SDUR) Q
26 .S SDAY=$$FMADD^XLFDT(SDAY,1) ;Increment days
27 .I SDAY>SDT S SDOUT=1,SDIND=$$IND(SDT,SDAY,SDUR)
28 .Q
29 Q SDIND
30 ;
31IND(SDT,SDAY,SDUR) ;Compute indicator
32 ;Input/Output: as described in NAVA entry point
33 Q $S(SDAY=SDT:2,1:0)+$S(SDUR="N":1,1:0)
34 ;
35PAT(SC,SDT) ;Return pattern for specified date (modified clone of OVR^SDAUT1)
36 ;Input: SC=clinic ifn
37 ;Input: SDT=date of pattern
38 ;Output: Current availability pattern for date selected
39 ; in the format of ^SC(clinic,"ST",date,1) nodes
40 ;
41 N SDI,SDIN,SDRE,SDSOH,SDD,SDJ,SDY,SDS,SDAY
42 S SDT=SDT\1
43 ;Inactivate/reactivate dates
44 S SDIN=$G(^SC(SC,"I")),SDRE=$P(SDIN,U,2),SDIN=$P(SDIN,U)
45 I '$$ACTIVE(SDT,SDIN,SDRE) Q "" ;Quit if not active on this date
46 S SDAY="SU^MO^TU^WE^TH^FR^SA" ;Day abbreviations
47 S SDI=$P($G(^SC(SC,"SL")),U,6),SDI=$S(SDI<3:4,1:SDI) ;Increments/hour
48 ;Schedule on holidays?
49 S SDSOH=$S('$D(^SC(SC,"SL")):0,$P(^SC(SC,"SL"),"^",8)']"":0,1:1)
50 Q:$O(^SC(SC,"T",0))>SDT "" ;Earlier than first availability date
51 S SDD=$$DOW^XLFDT(SDT,1) ;Day of week
52 K SDJ F SDY=0:1:6 I $D(^SC(+SC,"T"_SDY)) S SDJ(SDY)="" ;Patterns
53 I $D(^SC(+SC,"ST",SDT,1)) Q ^SC(+SC,"ST",SDT,1) ;Current availability
54 ;No ava. on file, quit if no pattern
55 I '$D(^SC(SC,"ST",SDT,1)) S SDY=SDD#7 Q:'$D(SDJ(SDY)) ""
56 ;Quit if holiday and no schedule
57 Q:$D(^HOLIDAY(SDT))&('SDSOH) " "_$E(SDT,6,7)_" "_$P(^(SDT,0),U,2)
58 ;Create availability string, quit if no pattern
59 S SDS=$O(^SC(SC,"T"_SDY,SDT)) Q:SDS<1 ""
60 Q:(^SC(SC,"T"_SDY,SDS,1)="") ""
61 Q $P(SDAY,U,SDY+1)_" "_$E(SDT,6,7)_$J("",SDI+SDI-6)_^SC(SC,"T"_SDY,SDS,1)
62 ;
63ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
64 ;Input: X=date to be examined
65 ;Input: SDIN=clinic inactive date
66 ;Input: SDRE=clinic reactivate date
67 ;Output: '1'=active, '0'=inactive
68 Q:'SDIN 1 Q:X<SDIN 1 Q:'SDRE 0 Q:X<SDRE 0 Q 1
69 ;
70INIT ;Initialize array for counting patterns
71 K SD N SDI
72 S SD="123456789jklmnopqrstuvwxyz"
73 F I=1:1:26 S SD($E(SD,I))=I
74 Q
75 ;
76PCNT(X) ;Count open slots in a pattern
77 ;Input: X=clinic availability pattern
78 ;Output: number of open slots in a single date pattern
79 N I,CT
80 S CT=0 Q:X'["[" CT
81 S X=$E(X,6,999),X=$TR(X,"|[] ","")
82 F I=1:1:$L(X) S CT=CT+$G(SD($E(X,I)))
83 Q CT
Note: See TracBrowser for help on using the repository browser.