| 1 | TMGSDAVG ;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 | ;
|
|---|
| 27 | GETAVAIL(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 | ;
|
|---|
| 75 | GAVDONE ;
|
|---|
| 76 | QUIT TMGRESULT
|
|---|
| 77 | ;
|
|---|
| 78 | ;
|
|---|
| 79 | GETINFO(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
|
|---|
| 140 | GIDONE ;
|
|---|
| 141 | QUIT TMGRESULT
|
|---|
| 142 | ;
|
|---|
| 143 | ; |
|---|
