source: cprs/branches/tmg-cprs/m_files/TMGSDAVG.m@ 1248

Last change on this file since 1248 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 7.2 KB
Line 
1TMGSDAVG ;TMG/kst/Get Schedule Availability Getting API ;12/08/08
2 ;;1.0;TMG-LIB;**1**;12/08/08
3 ;
4 ;"TMG SCHEDULING AVAILIBILITY GETTING
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"7-12-2005
8 ;
9 ;"NOTE: Much of this code originated from SDB*.m
10 ;"Called into from TMGRPC5
11 ;"
12 ;"=======================================================================
13 ;" API -- Public Functions.
14 ;"=======================================================================
15 ;"GETAVAIL(TMGIEN,TMGSTRTDT,TMGENDDT,TMGAVAIL,TMGMSG) -- Return an array with appt slot information: time, availibility
16 ;
17 ;"=======================================================================
18 ;" Private Functions.
19 ;"=======================================================================
20 ;"GETINFO(TMGIEN,TMG1DATE,TMGAVAIL,SAVARRAY) -- extract information from ST node, and return info into TMGAVAIL array
21 ;
22 ;"=======================================================================
23 ;"Dependancies
24 ;"=======================================================================
25 ;"=======================================================================
26 ;
27GETAVAIL(TMGIEN,TMGSTRTDT,TMGENDDT,TMGAVAIL,TMGMSG)
28 ;"Purpose: Return an array with appt slot information: time, availibility
29 ;"Input: TMGIEN -- the IEN in file 44 (HOSPITAL LOCATION) to check.
30 ;" TMGSTRTDT -- The beginning of the date range requested
31 ;" TMGENDDT -- The end of the date range requested
32 ;" TMGAVAIL -- PASS BY REFERENCE, an OUT PARAMETER. Format below. Prior values KILLED
33 ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
34 ;" TMGMSG=line count of error messages
35 ;" TMGMSG(1)=ErrMsg
36 ;" TMGMSG(2)=ErrMsg etc..
37 ;"Output: TMGAVAIL filled as follows:
38 ;" TMGAVAIL("INFO","APPTLEN")=LengthOfApptSlot
39 ;" TMGAVAIL(Date,SlotStartTime)=NumOpenings^NumTotalSlotsAtTime
40 ;" TMGAVAIL(Date,SlotStartTime)=NumOpenings^NumTotalSlotsAtTime
41 ;"Note: If a clinic is not set up for a given day in date range, no results will be
42 ;" returned for that invalid day.
43 ;"Result: 1 = Success or
44 ;" 0 = Intermediate success
45 ;" -1 = error
46 ;
47 NEW TMGRESULT SET TMGRESULT=1
48 ;"---Validate input values ---
49 SET TMGIEN=+$GET(TMGIEN)
50 IF (TMGIEN'>0)!($DATA(^SC(TMGIEN))=0) DO GOTO GAVDONE
51 . SET TMGMSG=+$GET(TMGMSG)+1
52 . SET TMGMSG(TMGMSG)="Location value of '"_TMGIEN_"' does not appear to refer to actual location."
53 . SET TMGRESULT=-1
54 SET TMGSTRTDT=$GET(TMGSTRTDT)\1
55 IF (TMGSTRTDT'?7N) DO GOTO GAVDONE
56 . SET TMGMSG=+$GET(TMGMSG)+1
57 . SET TMGMSG(TMGMSG)="Date: "_TMGSTRTDT_" Doesn't seem to be proper start date, in Fileman format."
58 . SET TMGRESULT=-1
59 SET TMGENDDT=$GET(TMGENDDT)\1
60 IF (TMGENDDT'?7N) DO GOTO GAVDONE
61 . SET TMGMSG=+$GET(TMGMSG)+1
62 . SET TMGMSG(TMGMSG)="Date: "_TMGENDDT_" Doesn't seem to be proper start date, in Fileman format."
63 . SET TMGRESULT=-1
64 ;
65 KILL TMGAVAIL
66 NEW TMGSAV ;"Scatch temp save array to speed processing.
67 NEW TMG1DATE SET TMG1DATE=TMGSTRTDT
68 FOR DO SET TMG1DATE=$$ADD2DATE^TMGSDAU1(TMG1DATE,1) QUIT:(TMG1DATE>TMGENDDT)!(TMGRESULT=-1)
69 . SET TMGRESULT=$$GETINFO(TMGIEN,TMG1DATE,.TMGAVAIL,.TMGSAV,.TMGMSG)
70 . IF TMGRESULT=1 QUIT ;"Skip error checking
71 . IF $GET(TMGMSG(1))["NO TEMPLATE" DO QUIT
72 . . KILL TMGMSG
73 . . SET TMGRESULT=1 ;"Ignore errors when checking days not defined in clinic.
74 ;
75GAVDONE ;
76 QUIT TMGRESULT
77 ;
78 ;
79GETINFO(TMGIEN,TMG1DATE,TMGAVAIL,TMGSAV,TMGMSG)
80 ;"Purpose: To extract information from ST node, and return info into TMGAVAIL array
81 ;"Input: TMGIEN -- IEN in file 44
82 ;" TMG1DATE -- The date to get info for
83 ;" TMGAVAIL -- PASS BY REFERENCE, an OUT PARAMETER. Format:
84 ;" TMGAVAIL("INFO","APPTLEN")=LengthOfApptSlot
85 ;" TMGAVAIL(Date,SlotStartTime)=NumOpenings^NumScheduled^NumTotalSlotsAtTime
86 ;" TMGAVAIL(Date,SlotStartTime)=NumOpenings^NumScheduled^NumTotalSlotsAtTime
87 ;" (Date is in FMFormat)
88 ;" NOTE: if no availibility then the following is returned:
89 ;" TMGAVAIL(Date,"0000")=0^0^0
90 ;" TMGSAV -- PASS BY REFERENCE. This is just a speed enhancing
91 ;" array, where prior effort at prior lookups is stored for future reference
92 ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
93 ;" TMGMSG=line count of error messages
94 ;" TMGMSG(1)=ErrMsg
95 ;" TMGMSG(2)=ErrMsg etc..
96 ;"Result: 1 = Success or
97 ;" 0 = Intermediate success
98 ;" -1 = error
99 NEW TMGRESULT
100 SET TMGRESULT=$$ENSUR1ST^TMGSDAU(TMGIEN,TMG1DATE,.TMGMSG) ;"Ensure ST node is set up
101 IF TMGRESULT=-1 GOTO GIDONE
102 ;
103 NEW STR SET STR=$GET(^SC(TMGIEN,"ST",TMG1DATE\1,1))
104 IF STR="" SET TMGRESULT=0 GOTO GIDONE
105 ;
106 SET TMGAVAIL("INFO","APPTLEN")=$PIECE($GET(^SC(TMGIEN,"SL")),"^",1)
107 ;
108 ;"--- Find applicable T node, which holds slot information
109 ;"Search backwards from specified date, looking for matching day of week.
110 NEW SLOTREF SET SLOTREF=""
111 NEW DOW SET DOW=$$DOW^XLFDT(TMG1DATE,1) ;"DOW=Day of Week (0-6)
112 NEW DATE SET DATE=TMG1DATE
113 FOR DO SET DATE=$ORDER(^SC(TMGIEN,"T",DATE),-1) QUIT:(DATE'>0)!(SLOTREF'="")
114 . IF $DATA(^SC(TMGIEN,"T",DATE))=0 QUIT ;"Needed for first cycle
115 . IF $$DOW^XLFDT(DATE,1)'=DOW QUIT ;"Only consider entries on same day of week
116 . SET SLOTREF=$NAME(^SC(TMGIEN,"T",DATE,2))
117 IF SLOTREF="" DO GOTO GIDONE
118 . SET TMGRESULT=0
119 . SET TMGAVAIL(TMG1DATE\1,"0000")="0^0^0" ;"Store arbitrary zero slot at 0000 to show we looked.
120 ;
121 SET DATE=TMG1DATE\1
122 ;"Cycle through slots, and get openings.
123 ;"Note: Another approach would be look at appts themselves in the "S" nodes instead of using
124 ;" compiled "ST" node, originating from appts. This assumes that VistA code will keep
125 ;" "ST" nodes refreshed as new appts are added.
126 NEW CODES SET CODES="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz" ;"Note 0 is 37th character
127 NEW COUNT SET COUNT=0
128 FOR SET COUNT=$ORDER(@SLOTREF@(COUNT)) QUIT:(COUNT'>0) DO
129 . NEW SLENTRY,SLTIME
130 . SET SLENTRY=$GET(@SLOTREF@(COUNT,0)) QUIT:SLENTRY=""
131 . SET SLTIME=$PIECE(SLENTRY,"^",1) QUIT:SLTIME=""
132 . NEW TOTALSL SET TOTALSL=+$PIECE(SLENTRY,"^",2)
133 . NEW APPT SET APPT=DATE_"."_SLTIME
134 . NEW INDEX SET INDEX=$$SLTINDEX^TMGSDAU(TMGIEN,APPT,.TMGSAV)
135 . NEW CHAR SET CHAR=$EXTRACT(STR,INDEX)
136 . IF CHAR="" SET CHAR=" "
137 . NEW OPENSL SET OPENSL=$FIND(CODES,CHAR)-$FIND(CODES,"0")
138 . NEW NUMSCH SET NUMSCH=TOTALSL-OPENSL
139 . SET TMGAVAIL(DATE,SLTIME)=OPENSL_"^"_NUMSCH_"^"_TOTALSL
140GIDONE ;
141 QUIT TMGRESULT
142 ;
143 ;
Note: See TracBrowser for help on using the repository browser.