| 1 | TMGSDAU ;TMG/kst/Schedule Availability Utilities ;1/06/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;12/08/08
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG SCHEDULING AVAILIBILITY UTILITIES
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"12/22/08
|
|---|
| 8 | ;
|
|---|
| 9 | ;"NOTE: Much of this code originated from SDB*.m (heavily modified!)
|
|---|
| 10 | ;"
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;" API -- Public Functions.
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;"FRSH7ST(TMGIEN,TMG1DATE,TMGMSG) -- Refresh 7 weeks of "ST" nodes, starting at given date.
|
|---|
| 15 | ;"ENSUR1ST(TMGIEN,TMG1DATE,TMGMSG) -- Ensure a "ST" node exists for a given date.
|
|---|
| 16 | ;"FORCE1ST(TMGIEN,TMG1DATE,TMGMSG) -- make/remake a "ST" node for a given date.
|
|---|
| 17 | ;"PAT4DAY(TMGIEN,TMG1DATE,TMGARR,TMGMSG) -- return a pattern appropriate for placing in "ST" for date.
|
|---|
| 18 | ;"FIX1ST(TMGIEN,TMG1DATE,TMGMSG) -- set slot numbers to match existing appts.
|
|---|
| 19 | ;"DEC1SLOT(TMGIEN,APPT,TMGMSG) -- decrement the availability number for a slot at a given time
|
|---|
| 20 | ;"SLTINDEX(TMGIEN,APPT,SAVARR) -- return INDEX in "ST" PATTERN node for given appt slot time
|
|---|
| 21 | ;"SPECPAT(TMGIEN,DATE,AVAILSTR) -- Add header to AvailStr
|
|---|
| 22 | ;
|
|---|
| 23 | ;"=======================================================================
|
|---|
| 24 | ;"Dependancies
|
|---|
| 25 | ;"=======================================================================
|
|---|
| 26 | ;"=======================================================================
|
|---|
| 27 | ;
|
|---|
| 28 | FRSH7ST(TMGIEN,TMG1DATE,TMGMSG)
|
|---|
| 29 | ;"Purpose: To Refresh 7 weeks of "ST" nodes, starting at given date.
|
|---|
| 30 | ;" (All on same day of week.)
|
|---|
| 31 | ;" It will copy from LIMDTate nodes if needed, and then check for
|
|---|
| 32 | ;" any existing appts on that date, and add them if needed.
|
|---|
| 33 | ;" NOTE: if the "ST" node already exists, it Will be remade.
|
|---|
| 34 | ;"Input: TMGIEN -- IEN in file 44 to work on
|
|---|
| 35 | ;" TMG1DATE -- the date to start refreshing ST on
|
|---|
| 36 | ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
|
|---|
| 37 | ;" TMGMSG=line count of error messages
|
|---|
| 38 | ;" TMGMSG(1)=ErrMsg
|
|---|
| 39 | ;" TMGMSG(2)=ErrMsg etc..
|
|---|
| 40 | ;"Globally-scoped vars used: ...
|
|---|
| 41 | ;"Result: 1 = Success or
|
|---|
| 42 | ;" 0 = Intermediate success
|
|---|
| 43 | ;" -1 = error
|
|---|
| 44 | ;
|
|---|
| 45 | NEW TMGRESULT SET TMGRESULT=1
|
|---|
| 46 | LOCK +^SC(TMGIEN,"ST"):10
|
|---|
| 47 | ELSE DO GOTO FR7DONE
|
|---|
| 48 | . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 49 | . SET TMGMSG(TMGMSG)="Unable to get lock on ^SC("_TMGIEN_",""ST"",)."
|
|---|
| 50 | . SET TMGRESULT=-1
|
|---|
| 51 | NEW COUNT,DATE
|
|---|
| 52 | SET DATE=TMG1DATE
|
|---|
| 53 | FOR COUNT=1:1:7 DO QUIT:(TMGRESULT'=1)
|
|---|
| 54 | . KILL ^SC(TMGIEN,"ST",DATE)
|
|---|
| 55 | . SET TMGRESULT=$$FORCE1ST(TMGIEN,DATE,.TMGMSG)
|
|---|
| 56 | . SET DATE=$$ADD2DATE^TMGAVLS1(DATE,7)
|
|---|
| 57 | LOCK -^SC(TMGIEN,"ST")
|
|---|
| 58 | FR7DONE ;
|
|---|
| 59 | QUIT TMGRESULT
|
|---|
| 60 | ;
|
|---|
| 61 | ;
|
|---|
| 62 | ENSUR1ST(TMGIEN,TMG1DATE,TMGMSG)
|
|---|
| 63 | ;"Purpose: To Ensure a "ST" node exists for a given date.
|
|---|
| 64 | ;" It will copy from LIMDTate nodes if needed, and then check for
|
|---|
| 65 | ;" any existing appts on that date, and add them if needed.
|
|---|
| 66 | ;" NOTE: if the "ST" node already exists, it will NOT be remade.
|
|---|
| 67 | ;"Input: TMGIEN -- IEN in file 44 to work on
|
|---|
| 68 | ;" TMG1DATE -- the date to force ST for. Don't pass by reference
|
|---|
| 69 | ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
|
|---|
| 70 | ;" TMGMSG=line count of error messages
|
|---|
| 71 | ;" TMGMSG(1)=ErrMsg
|
|---|
| 72 | ;" TMGMSG(2)=ErrMsg etc..
|
|---|
| 73 | ;"Globally-scoped vars used: ...
|
|---|
| 74 | ;"Result: 1 = Success or
|
|---|
| 75 | ;" 0 = Intermediate success
|
|---|
| 76 | ;" -1 = error
|
|---|
| 77 | ;
|
|---|
| 78 | NEW TMGRESULT SET TMGRESULT=1
|
|---|
| 79 | SET TMG1DATE=$GET(TMG1DATE)\1
|
|---|
| 80 | LOCK +^SC(TMGIEN,"ST",TMG1DATE):10
|
|---|
| 81 | ELSE DO GOTO E1STDONE
|
|---|
| 82 | . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 83 | . SET TMGMSG(TMGMSG)="Unable to get lock on ^SC("_TMGIEN_",""ST"","_TMG1DATE_")."
|
|---|
| 84 | . SET TMGRESULT=-1
|
|---|
| 85 | IF $DATA(^SC(TMGIEN,"ST",TMG1DATE))=0 DO
|
|---|
| 86 | . SET TMGRESULT=$$FORCE1ST(TMGIEN,TMG1DATE,.TMGMSG)
|
|---|
| 87 | LOCK -^SC(TMGIEN,"ST",TMG1DATE)
|
|---|
| 88 | E1STDONE ;
|
|---|
| 89 | QUIT TMGRESULT
|
|---|
| 90 | ;
|
|---|
| 91 | ;
|
|---|
| 92 | FORCE1ST(TMGIEN,TMG1DATE,TMGMSG)
|
|---|
| 93 | ;"Purpose: To make/remake a "ST" node for a given date.
|
|---|
| 94 | ;" It will copy from LIMDTate nodes if needed, and then check for
|
|---|
| 95 | ;" any existing appts on that date, and add them if needed.
|
|---|
| 96 | ;" NOTE: if the "ST" node already exists, it WILL be remade.
|
|---|
| 97 | ;"Input: TMGIEN -- IEN in file 44 to work on
|
|---|
| 98 | ;" TMG1DATE -- the date to force ST for.
|
|---|
| 99 | ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
|
|---|
| 100 | ;" TMGMSG=line count of error messages
|
|---|
| 101 | ;" TMGMSG(1)=ErrMsg
|
|---|
| 102 | ;" TMGMSG(2)=ErrMsg etc..
|
|---|
| 103 | ;"Globally-scoped vars used: ...
|
|---|
| 104 | ;"Result: 1 = Success or
|
|---|
| 105 | ;" 0 = Intermediate success
|
|---|
| 106 | ;" -1 = error
|
|---|
| 107 | ;
|
|---|
| 108 | NEW TMGRESULT,TMGARR
|
|---|
| 109 | NEW DATE SET DATE=TMG1DATE\1
|
|---|
| 110 | LOCK +^SC(TMGIEN,"ST",DATE):10
|
|---|
| 111 | ELSE DO GOTO M1STDONE
|
|---|
| 112 | . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 113 | . SET TMGMSG(TMGMSG)="Unable to get lock on ^SC("_TMGIEN_",""ST"","_DATE_")."
|
|---|
| 114 | . SET TMGRESULT=-1
|
|---|
| 115 | SET TMGRESULT=$$PAT4DAY(TMGIEN,TMG1DATE,.TMGARR,.TMGMSG)
|
|---|
| 116 | IF TMGRESULT'=1 GOTO M1STDONE
|
|---|
| 117 | KILL ^SC(TMGIEN,"ST",DATE)
|
|---|
| 118 | MERGE ^SC(TMGIEN,"ST",DATE)=TMGARR
|
|---|
| 119 | IF $$FIX1ST(TMGIEN,TMG1DATE,.TMGMSG)=-1 SET TMGRESULT=0
|
|---|
| 120 | LOCK -^SC(TMGIEN,"ST",TMG1DATE)
|
|---|
| 121 | M1STDONE ;
|
|---|
| 122 | QUIT TMGRESULT
|
|---|
| 123 | ;
|
|---|
| 124 | ;
|
|---|
| 125 | PAT4DAY(TMGIEN,TMG1DATE,TMGARR,TMGMSG)
|
|---|
| 126 | ;"Purpose: To return a pattern appropriate for placing in "ST" for date.
|
|---|
| 127 | ;"Input: TMGIEN -- IEN in file 44 to work on
|
|---|
| 128 | ;" TMG1DATE -- the date to work on.
|
|---|
| 129 | ;" TMGARR -- PASS BY REFERENCE. An OUT PARAMETER. Prior results killed.
|
|---|
| 130 | ;" This is an array that may be merged with ^SC(TMGIEN,"ST",DATE)
|
|---|
| 131 | ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
|
|---|
| 132 | ;" TMGMSG=line count of error messages
|
|---|
| 133 | ;" TMGMSG(1)=ErrMsg
|
|---|
| 134 | ;" TMGMSG(2)=ErrMsg etc..
|
|---|
| 135 | ;"Globally-scoped vars used: ...
|
|---|
| 136 | ;"Result: 1 = Success or
|
|---|
| 137 | ;" -1 = error
|
|---|
| 138 | ;
|
|---|
| 139 | KILL TMGARR
|
|---|
| 140 | NEW TMGRESULT SET TMGRESULT=-1 ;"default to failure
|
|---|
| 141 | NEW TMGSLNOD SET TMGSLNOD=$GET(^SC(TMGIEN,"SL")) ;"^SC(IEN,"SL", SL node
|
|---|
| 142 | NEW TMGSOH SET TMGSOH=($PIECE(TMGSLNOD,"^",8)="Y") ;"SOH=Schedule On Holidays.
|
|---|
| 143 | NEW DATE SET DATE=TMG1DATE\1 ;"strip minutes
|
|---|
| 144 | NEW DOW SET DOW=$$DOW^XLFDT(DATE,1)#7
|
|---|
| 145 | ;
|
|---|
| 146 | IF $DATA(^HOLIDAY(DATE))&('TMGSOH) DO GOTO P4DDONE
|
|---|
| 147 | . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 148 | . SET TMGMSG(TMGMSG)=$$EXTDAT^TMGAVLS1(DATE)_" is a holiday, and Location settings don't allow scheduling."
|
|---|
| 149 | ;
|
|---|
| 150 | IF $DATA(^SC(TMGIEN,"OST",DATE,1)) DO
|
|---|
| 151 | . MERGE TMGARR=^SC(TMGIEN,"OST",DATE)
|
|---|
| 152 | . SET TMGARR(9)=TMGIEN
|
|---|
| 153 | . SET TMGRESULT=1
|
|---|
| 154 | ;
|
|---|
| 155 | ;"IF '$DATA(^SC(TMGIEN,"ST",DATE,1)) DO ;"Copy from TEMPLATE for this day, date
|
|---|
| 156 | IF TMGRESULT'=1 DO ;"Copy from TEMPLATE for this day, date
|
|---|
| 157 | . NEW STR
|
|---|
| 158 | . NEW LIMDT SET LIMDT=+$ORDER(^SC(TMGIEN,"T"_DOW,DATE)) ;"Tx entries are LIMIT dated...
|
|---|
| 159 | . IF LIMDT'>0 QUIT
|
|---|
| 160 | . NEW TEMPL SET TEMPL=$GET(^SC(TMGIEN,"T"_DOW,LIMDT,1))
|
|---|
| 161 | . IF TEMPL="" QUIT
|
|---|
| 162 | . SET STR=$$SPECPAT(TMGIEN,DATE,TEMPL) ;"Return string like this: MO 05 | [2 2 2 2|2 2 2 2]
|
|---|
| 163 | . SET TMGARR(1)=STR
|
|---|
| 164 | . SET TMGARR(0)=DATE
|
|---|
| 165 | . SET TMGRESULT=1
|
|---|
| 166 | ;
|
|---|
| 167 | IF TMGRESULT=-1 DO
|
|---|
| 168 | . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 169 | . SET TMGMSG(TMGMSG)="NO TEMPLATE; Unable to find a slot pattern defined for "_$$EXTDAT^TMGSDAU1(DATE)
|
|---|
| 170 | ;
|
|---|
| 171 | P4DDONE ;
|
|---|
| 172 | QUIT TMGRESULT
|
|---|
| 173 | ;
|
|---|
| 174 | ;
|
|---|
| 175 | FIX1ST(TMGIEN,TMG1DATE,TMGMSG)
|
|---|
| 176 | ;"Purpose: To set slot numbers to match existing appts.
|
|---|
| 177 | ;"IMPORTANT NOTICE: This should *only* be called after a fresh template pattern
|
|---|
| 178 | ;" has been copied into the ST node. This is because this function
|
|---|
| 179 | ;" will decrease availability count for slots based on existing appts.
|
|---|
| 180 | ;" If this has already been done, then calling this again will result
|
|---|
| 181 | ;" in the availability count being reduced AGAIN--making it appear
|
|---|
| 182 | ;" that the slot is being used, when it actually is NOT.
|
|---|
| 183 | ;"Input: TMGIEN -- IEN in file 44 to work on
|
|---|
| 184 | ;" TMG1DATE -- the date to fix ST for.
|
|---|
| 185 | ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
|
|---|
| 186 | ;" TMGMSG=line count of error messages
|
|---|
| 187 | ;" TMGMSG(1)=ErrMsg
|
|---|
| 188 | ;" TMGMSG(2)=ErrMsg etc..
|
|---|
| 189 | ;"Globally-scoped vars used: TMGIEN
|
|---|
| 190 | ;"Result: 1 = Success or
|
|---|
| 191 | ;" -1 = error
|
|---|
| 192 | ;
|
|---|
| 193 | NEW TMGRESULT SET TMGRESULT=1
|
|---|
| 194 | NEW APPT SET APPT=TMG1DATE\1 ;"All appts should have time, by trimming time, will sort before actual appts
|
|---|
| 195 | FOR SET APPT=$ORDER(^SC(TMGIEN,"S",APPT)) QUIT:(APPT\1'=TMG1DATE\1)!(TMGRESULT=-1) DO ;"Only check same day
|
|---|
| 196 | . IF $$NONAPPT(TMGIEN,APPT) QUIT
|
|---|
| 197 | . SET TMGRESULT=$$DEC1SLOT(TMGIEN,APPT,.TMGMSG)
|
|---|
| 198 | F1STDONE ;
|
|---|
| 199 | QUIT TMGRESULT
|
|---|
| 200 | ;
|
|---|
| 201 | ;
|
|---|
| 202 | DEC1SLOT(TMGIEN,APPT,TMGMSG)
|
|---|
| 203 | ;"Purpose: To decrement the availability number for a slot at a given time
|
|---|
| 204 | ;"Input: TMGIEN -- IEN in file 44 to work on
|
|---|
| 205 | ;" APPT -- A FMDateTime number to indicate date & time of appt.
|
|---|
| 206 | ;" TMGMSG -- PASS BY REFERENCE, an OUT PARAMETER. Format:
|
|---|
| 207 | ;" TMGMSG=line count of error messages
|
|---|
| 208 | ;" TMGMSG(1)=ErrMsg
|
|---|
| 209 | ;" TMGMSG(2)=ErrMsg etc..
|
|---|
| 210 | ;"Globally-scoped vars used: TMGIEN
|
|---|
| 211 | ;"Result: 1 = Success or
|
|---|
| 212 | ;" -1 = error
|
|---|
| 213 | ;
|
|---|
| 214 | NEW TMGRESULT SET TMGRESULT=1 ;"default to success
|
|---|
| 215 | NEW DATE SET DATE=APPT\1
|
|---|
| 216 | LOCK +^SC(TMGIEN,"ST",DATE):10 ;"Prevent interferance from any other process.
|
|---|
| 217 | ELSE DO GOTO D1SDONE
|
|---|
| 218 | . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 219 | . SET TMGMSG(TMGMSG)="Unable to get lock on ^SC("_TMGIEN_",""ST"","_DATE_")."
|
|---|
| 220 | . SET TMGRESULT=-1
|
|---|
| 221 | NEW STR SET STR=$GET(^SC(TMGIEN,"ST",DATE,1))
|
|---|
| 222 | IF STR="" DO GOTO D1SUL
|
|---|
| 223 | . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 224 | . SET TMGMSG(TMGMSG)="Can't find a PATTERN entry for "_$$EXTDAT^TMGAVLS1(DATE)_", so can't decrease slot availability."
|
|---|
| 225 | . SET TMGRESULT=-1
|
|---|
| 226 | ;
|
|---|
| 227 | NEW INDX SET INDX=$$SLTINDEX(TMGIEN,APPT)
|
|---|
| 228 | ;"G X:(I<1!'$F(S,"["))&(S'["CAN")
|
|---|
| 229 | ;"I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
|
|---|
| 230 | ;
|
|---|
| 231 | NEW CODES SET CODES="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
|
|---|
| 232 | FOR QUIT:(INDX'>$LENGTH(STR))!($LENGTH(STR)'<IOM) SET STR=STR_" "
|
|---|
| 233 | ;
|
|---|
| 234 | ;"Note: I am not sure what SDDIF or SS is here, and trials runs only went through once, will will not loop
|
|---|
| 235 | ;"FOR INDX=(SLOTINDX*2):SDDIF:SS-SDDIF DO QUIT:(TMGRESULT=-1)
|
|---|
| 236 | DO
|
|---|
| 237 | . NEW TEMP,DECCHR
|
|---|
| 238 | . SET TEMP=$EXTRACT(STR,INDX)
|
|---|
| 239 | . IF TEMP="" SET TEMP=" "
|
|---|
| 240 | . SET DECCHR=$EXTRACT(CODES,$FIND(CODES,TEMP)-2) ;"Return char occuring just before TEMP value in STR
|
|---|
| 241 | . IF (STR["CAN")!((TEMP="X")&($DATA(^SC(TMGIEN,"ST",DATE,"CAN")))) DO QUIT
|
|---|
| 242 | . . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 243 | . . SET TMGMSG(TMGMSG)="Can't alter slots within a CANCELLED time period.!"
|
|---|
| 244 | . . SET TMGRESULT=-1
|
|---|
| 245 | . IF DECCHR="" DO QUIT
|
|---|
| 246 | . . SET TMGMSG=+$GET(TMGMSG)+1
|
|---|
| 247 | . . SET TMGMSG(TMGMSG)="Error in DEC1SLOT^TMGAVLG: DECCHR=''"
|
|---|
| 248 | . . SET TMGRESULT=-1
|
|---|
| 249 | . ;"IF (DECCHR'?1NL)&(SM<6) SET SM=6 ;"Look for DECCHR as number or lowercase letter
|
|---|
| 250 | . SET TEMP=$EXTRACT(STR,INDX+1,999)
|
|---|
| 251 | . IF TEMP="" SET TEMP=" "
|
|---|
| 252 | . SET STR=$EXTRACT(STR,1,INDX-1)_DECCHR_TEMP
|
|---|
| 253 | ;
|
|---|
| 254 | SET ^SC(TMGIEN,"ST",DATE,1)=STR ;"Store new pattern.
|
|---|
| 255 | D1SUL LOCK -^SC(TMGIEN,"ST",DATE) ;"Release lock
|
|---|
| 256 | D1SDONE ;
|
|---|
| 257 | QUIT TMGRESULT
|
|---|
| 258 | ;
|
|---|
| 259 | ;
|
|---|
| 260 | SLTINDEX(TMGIEN,APPT,SAVARR)
|
|---|
| 261 | ;"Purpose: To return INDEX in "ST" PATTERN node for given appt slot time
|
|---|
| 262 | ;"Input: TMGIEN -- IEN in file 44
|
|---|
| 263 | ;" APPT -- FMDateTime of appointment
|
|---|
| 264 | ;" SAVARR -- PASS BY REFERANCE. A save array, so that prior lookups can be reused. Format:
|
|---|
| 265 | ;" SAVARR(DateTime)=Index
|
|---|
| 266 | ;" SAVARR(DateTime)=Index
|
|---|
| 267 | ;" SAVARR("T",STR,MilitaryTime)=Index
|
|---|
| 268 | ;" SAVARR("T",STR,MilitaryTime)=Index
|
|---|
| 269 | ;"Globally-scoped vars used: TMGIEN
|
|---|
| 270 | ;"Result: Returns 0 if problem
|
|---|
| 271 | ;" Otherwise returns index value for accessing character in "ST",1) node.
|
|---|
| 272 | ;
|
|---|
| 273 | NEW TMGRESULT SET TMGRESULT=0
|
|---|
| 274 | IF $DATA(SAVARR(APPT)) DO GOTO SLIDONE ;"Use prior lookup if possible
|
|---|
| 275 | . SET TMGRESULT=+$GET(SAVARR(APPT))
|
|---|
| 276 | NEW DATE SET DATE=APPT\1
|
|---|
| 277 | NEW MILTIME SET MILTIME=(APPT#1)*1000
|
|---|
| 278 | NEW STR SET STR=$GET(^SC(TMGIEN,"ST",DATE,1))
|
|---|
| 279 | IF STR="" SET TMGRESULT=0 GOTO SLIDONE
|
|---|
| 280 | SET STR=$PIECE(STR,"|",2,25)
|
|---|
| 281 | IF $DATA(SAVARR("T",STR,MILTIME)) DO GOTO SLIDONE
|
|---|
| 282 | . SET TMGRESULT=+$GET(SAVARR("T",STR,MILTIME))
|
|---|
| 283 | ;
|
|---|
| 284 | NEW TMGSPH SET TMGSPH=+$P($GET(^SC(TMGIEN,"SL")),"^",6) ;"SL;6 = DISPLAY INCS PER HOUR (Slots per Hr)
|
|---|
| 285 | IF TMGSPH'>0 SET TMGSPH=4 ;"Default to 4 slots/hr
|
|---|
| 286 | NEW STARTDAY SET STARTDAY=+$P($GET(^SC(TMGIEN,"SL")),"^",3) ;"SL;3=HR CLINIC DISPLAY BEGINS
|
|---|
| 287 | NEW SB SET SB=(STARTDAY-1)/100 ;"Eg 8 am --> .07
|
|---|
| 288 | ;
|
|---|
| 289 | ;"Convert Hrs.Min --> fractional hours. e.g. 1:30 --> 1.5; 3.45 --> 3.75
|
|---|
| 290 | NEW HROFFSET SET HROFFSET=((APPT#1)-SB)*100 ;"HROFFSET=Num of Hrs (i.e. hrs.min 1.3=1 hr, 30 min) **past** display start time (i.e. 7am)
|
|---|
| 291 | ;"Note: SB is usually 1 hr before true display start time. I.e. .07 for start time of 8 am
|
|---|
| 292 | ;" I think this is to allow for the header info (e.g. 'SUN 04 |')
|
|---|
| 293 | NEW MINOFFST SET MINOFFST=HROFFSET#1 ;"Get just minutes part, e.g. 0.3 (i.e. 30 minutes)
|
|---|
| 294 | SET HROFFSET=HROFFSET\1 ;"Get just hrs part
|
|---|
| 295 | SET MINOFFST=MINOFFST/0.6 ;"integer divide (i.e round output) by 0.6, e.g. 1.2/0.6 --> 2. Note, 0.6 here means 60 minutes
|
|---|
| 296 | ;"SET MINOFFST=MINOFFST*TMGSPH ;"multiply by slots/hr, e.g. 4 --> 0.3 * 4 = 1.2 (i.e. 120 minutes)
|
|---|
| 297 | NEW SLOTINDX SET SLOTINDX=(HROFFSET+MINOFFST)*TMGSPH ;"Add number of hrs past display start time * slots/hr --> slot index #
|
|---|
| 298 | ;
|
|---|
| 299 | SET TMGRESULT=(SLOTINDX*2)+1 ;"x2 because of spaces etc between character values, and 1st slot begins 1 character after '|'
|
|---|
| 300 | ;
|
|---|
| 301 | SET SAVARR(APPT)=TMGRESULT
|
|---|
| 302 | SET SAVARR("T",STR,MILTIME)=TMGRESULT
|
|---|
| 303 | SLIDONE ;
|
|---|
| 304 | QUIT TMGRESULT
|
|---|
| 305 | ;
|
|---|
| 306 | ;
|
|---|
| 307 | SPECPAT(TMGIEN,DATE,AVAILSTR)
|
|---|
| 308 | ;"Purpose: Return string like this: MO 05 | [2 2 2 2|2 2 2 2]
|
|---|
| 309 | ;" ... given the original pattern string ('AvailStr'), e.g. ' [2 2 2 2|2 2 2 2]'
|
|---|
| 310 | NEW DOW SET DOW=$$DOW^XLFDT(DATE,1) ;"DOW=Day of Week (0-6)
|
|---|
| 311 | NEW TMGSPH SET TMGSPH=+$P($GET(^SC(TMGIEN,"SL")),"^",6) ;"SL;6 = DISPLAY INCS PER HOUR (Slots per Hr)
|
|---|
| 312 | IF TMGSPH'>0 SET TMGSPH=4 ;"Default to 4 slots/hr
|
|---|
| 313 | NEW SI SET SI=+TMGSPH
|
|---|
| 314 | IF (SI=0)!(SI=1)!(SI=2) SET SI=4
|
|---|
| 315 | NEW SM
|
|---|
| 316 | SET SM=$P("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "
|
|---|
| 317 | SET SM=SM_$EXTRACT(DATE,6,7)_$J("",SI+SI-6)
|
|---|
| 318 | SET SM=SM_AVAILSTR_$J("",64-$LENGTH(AVAILSTR))
|
|---|
| 319 | QUIT SM
|
|---|
| 320 | ;
|
|---|
| 321 | ;
|
|---|
| 322 | NONAPPT(TMGIEN,APPT)
|
|---|
| 323 | ;"Purpose: To see if appointment is inactivated (i.e. a Non-Appt)
|
|---|
| 324 | ;"Input: TMGIEN -- IEN in file 44
|
|---|
| 325 | ;" APPT -- FMDateTime of appointment
|
|---|
| 326 | ;"Result: 0 if appt is active, 1 if cancelled etc.
|
|---|
| 327 | NEW TMGRESULT SET TMGRESULT=1 ;"Default to cancelled.
|
|---|
| 328 | NEW DFN SET DFN=+$PIECE($GET(^SC(TMGIEN,"S",APPT,1,1,0)),"^",1) ;"Patient IEN
|
|---|
| 329 | IF DFN'>0 SET TMGRESULT=-1 GOTO NADONE
|
|---|
| 330 | NEW STATUS SET STATUS=$PIECE($GET(^DPT(DFN,"S",APPT,0)),"^",2) ;"Status field
|
|---|
| 331 | IF STATUS="" SET TMGRESULT=0
|
|---|
| 332 | NADONE QUIT TMGRESULT
|
|---|
| 333 | ;
|
|---|
| 334 | ; |
|---|
