| [796] | 1 | TMGSDAU2 ;TMG/kst/Schedule Availability Utilities 2;12/22/08
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;12/22/08
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG SCHEDULING UTILITIES 2
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"01/12/09
|
|---|
| 8 | ;
|
|---|
| 9 | ;"=======================================================================
|
|---|
| 10 | ;" API -- Public Functions.
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;"GETDFN(PATIENT) -- return DFN value for patient
|
|---|
| 13 | ;"GETCLIEN(CLINIC) - return Clinics IEN value for patient
|
|---|
| 14 | ;"GETDATE(APPT) - return a FM Date-time formated value
|
|---|
| 15 | ;"FILLAVAL(TMGIEN,PARRAY,TMG1DATE,TMGLIMDT,TMGERR,TMGMSG) --Fill in AVAILABILITY subfile ("T" node)
|
|---|
| 16 | ;"KILLAVAL(TMGIEN,TMG1DATE,TMGLIMDT,TMGFLAGS) -- Delete AVAILABILITY ("T") node, and any linked "ST" and "OST" nodes.
|
|---|
| 17 | ;"KILL1DATE(TMGIEN,TMG1DATE,FULL) -- remove 1 "T" node, and any linked ST and OST nodes
|
|---|
| 18 | ;"STR2PAT(TMGIEN,STR,PARRAY) -- Convert a template pattern into an array of times.
|
|---|
| 19 | ;"FRAC2TIM(TIME,HRS,MINS) -- Convert Fractional time --> Hrs & Min e.g. 3.75 --> 3 & 45 (i.e. 3:45)
|
|---|
| 20 | ;"CH2NAVAL(CH)-- convert a given availability character into number of slots there.
|
|---|
| 21 | ;
|
|---|
| 22 | ;"=======================================================================
|
|---|
| 23 | ;"Dependancies
|
|---|
| 24 | ;"=======================================================================
|
|---|
| 25 | ;
|
|---|
| 26 | ;"=======================================================================
|
|---|
| 27 | ;
|
|---|
| 28 | GETDFN(PATIENT)
|
|---|
| 29 | ;"Purpose: return DFN value for patient
|
|---|
| 30 | ;" This is a much simpler function that TMGGDFN, different purpose
|
|---|
| 31 | ;"Input: PATIENT. Either a patient name (must be unique) or IEN
|
|---|
| 32 | ;"Results: IEN in PATIENT file, or -101^Message
|
|---|
| 33 | ;
|
|---|
| 34 | NEW RESULT SET RESULT=0
|
|---|
| 35 | SET PATIENT=$GET(PATIENT)
|
|---|
| 36 | IF PATIENT="" DO GOTO GDDONE
|
|---|
| 37 | . SET RESULT="-101^Patient not specified."
|
|---|
| 38 | IF +PATIENT=PATIENT SET RESULT=PATIENT
|
|---|
| 39 | ELSE DO
|
|---|
| 40 | . NEW TMG2MSG
|
|---|
| 41 | . DO FIND^DIC(2,,".01","MP",ANAME,"*","","","","TMG2MSG")
|
|---|
| 42 | . NEW NUM SET NUM=+$GET(TMG2MSG("DILIST",0))
|
|---|
| 43 | . IF NUM=0 DO QUIT
|
|---|
| 44 | . . SET RESULT="-101^Patient name: '"_PATIENT_"' NOT FOUND"
|
|---|
| 45 | . IF NUM>1 DO QUIT
|
|---|
| 46 | . . SET TMGMSG(TMGMSG)="-101^Name: "_PATIENT_" Not specific. Multiple patients with this name exist."
|
|---|
| 47 | . SET RESULT=+$GET(TMG2MSG("DILIST",1,0))
|
|---|
| 48 | GDDONE ;
|
|---|
| 49 | QUIT RESULT
|
|---|
| 50 | ;
|
|---|
| 51 | ;
|
|---|
| 52 | GETCLIEN(CLINIC)
|
|---|
| 53 | ;"Purpose: return Clinics IEN value for patient
|
|---|
| 54 | ;"Input: CLINIC -- Name, or IEN, of Clinic for appt (file 44)
|
|---|
| 55 | ;"Results: IEN in HOSPITAL LOCATION (44), or -102^Message
|
|---|
| 56 | NEW RESULT
|
|---|
| 57 | SET CLINIC=$GET(CLINIC)
|
|---|
| 58 | IF CLINIC="" DO GOTO GCLDONE
|
|---|
| 59 | . SET RESULT="-102^Clinic location not provided."
|
|---|
| 60 | IF +CLINIC=CLINIC SET RESULT=CLINIC
|
|---|
| 61 | ELSE DO
|
|---|
| 62 | . NEW DIC,X,Y
|
|---|
| 63 | . SET DIC=44,DIC(0)="M"
|
|---|
| 64 | . SET X=CLINIC DO ^DIC
|
|---|
| 65 | . IF +Y>0 SET RESULT=+Y
|
|---|
| 66 | . ELSE SET RESULT="-102^'"_CLINIC_"' clinic location NOT FOUND."
|
|---|
| 67 | GCLDONE ;
|
|---|
| 68 | QUIT RESULT
|
|---|
| 69 | ;
|
|---|
| 70 | ;
|
|---|
| 71 | GETDATE(APPT)
|
|---|
| 72 | ;"Purpose: return a FM Date-time formated value
|
|---|
| 73 | ;"Input: APPT -- Desired Appointment Date & Time -- External, or FM format
|
|---|
| 74 | ;"Results: FM Date-Time entry or -1^Message
|
|---|
| 75 | ;
|
|---|
| 76 | NEW RESULT
|
|---|
| 77 | SET APPT=$GET(APPT)
|
|---|
| 78 | IF APPT="" DO GOTO GAPDONE
|
|---|
| 79 | . SET RESULT="-1^Date and time not provided"
|
|---|
| 80 | IF +APPT=APPT SET RESULT=APPT
|
|---|
| 81 | ELSE DO
|
|---|
| 82 | . DO DT^DILF("T",APPT,.RESULT)
|
|---|
| 83 | . IF RESULT=-1 SET RESULT="-1^'"_APPT_"' is not a valid Date-Time"
|
|---|
| 84 | GAPDONE ;
|
|---|
| 85 | QUIT RESULT
|
|---|
| 86 | ;
|
|---|
| 87 | ;
|
|---|
| 88 | FILLAVAL(TMGIEN,PARRAY,TMG1DATE,TMGLIMDT,TMGERR,TMGMSG)
|
|---|
| 89 | ;"Purpose: Fill in AVAILABILITY subfile ("T" node), specifying number
|
|---|
| 90 | ;" of patients allowed in each slot
|
|---|
| 91 | ;" Note: This creates entries for each slot, 1 for each time slot.
|
|---|
| 92 | ;" The T node does not store an ending date for the pattern.
|
|---|
| 93 | ;" It appears to apply until a next date is encountered (if any)
|
|---|
| 94 | ;" Also, this is set for cases where set days are being specified
|
|---|
| 95 | ;" as well as when date ranges are specified.
|
|---|
| 96 | ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
|
|---|
| 97 | ;" PARRAY -- PASS BY NAME. Array containing time data. e.g.:
|
|---|
| 98 | ;" @PARRAY@("0800-0810")=2
|
|---|
| 99 | ;" @PARRAY@("0830-0850")=1
|
|---|
| 100 | ;" @PARRAY@("0900-0930")=1
|
|---|
| 101 | ;" @PARRAY@("1000-1140")=1
|
|---|
| 102 | ;" TMG1DATE -- Starting date of a range to put entry into
|
|---|
| 103 | ;" TMGLIMDT -- Limit date of date range.
|
|---|
| 104 | ;" TMGERR -- PASS BY REFERANCE
|
|---|
| 105 | ;" TMGMSG -- PASS BY REFERANCE
|
|---|
| 106 | ;"Globally Scoped vars used: ...
|
|---|
| 107 | ;"Result: NONE
|
|---|
| 108 | ;"Note: It is presumed record locking has already occured
|
|---|
| 109 | ;"Note: It is assumed that prior "T" nodes are gone,
|
|---|
| 110 | ;" which may be achieved by DO KILLAVAL(TMG1DATE,TMGLIMDT,TMGFLAGS)
|
|---|
| 111 | ;
|
|---|
| 112 | NEW STARTDAY SET STARTDAY=+$P($GET(^SC(TMGIEN,"SL")),"^",3) ;"SL;3=HR CLINIC DISPLAY BEGINS
|
|---|
| 113 | IF STARTDAY'>0 SET STARTDAY=8 ;"Default to start at 8 am
|
|---|
| 114 | ;
|
|---|
| 115 | ;"--Delete all preexisting T nodes in new date range-- SHOULD ALREADY BE DONE VIA KILLAVAL
|
|---|
| 116 | ;
|
|---|
| 117 | FA1 ;" -- Set up T nodes for new date range --
|
|---|
| 118 | NEW LASTTIME SET LASTTIME=STARTDAY*100
|
|---|
| 119 | NEW COUNT SET COUNT=0
|
|---|
| 120 | NEW TMGTIMES SET TMGTIMES=""
|
|---|
| 121 | FOR SET TMGTIMES=$ORDER(@PARRAY@(TMGTIMES)) QUIT:(TMGTIMES="")!TMGERR DO
|
|---|
| 122 | . NEW T1,T2,MIN,H1,H2,M1,M2
|
|---|
| 123 | . SET T1=$P(TMGTIMES,"-",1)
|
|---|
| 124 | . SET T2=$P(TMGTIMES,"-",2)
|
|---|
| 125 | . ;"process individual times.
|
|---|
| 126 | . NEW APTSPER SET APTSPER=+$GET(@PARRAY@(TMGTIMES))
|
|---|
| 127 | . SET LASTTIME=T2
|
|---|
| 128 | . DO MILSUB^TMGSDAU1(.T2,TMGSDUR,.H2,.M2)
|
|---|
| 129 | . DO MILADD^TMGSDAU1(.T1,0,.H1,.M1)
|
|---|
| 130 | . FOR DO QUIT:(T1>T2)
|
|---|
| 131 | . . SET COUNT=COUNT+1
|
|---|
| 132 | . . ;"Store Time^#ApptsInSlot in "T" node
|
|---|
| 133 | . . SET ^SC(TMGIEN,"T",TMG1DATE,2,COUNT,0)=H1_M1_"^"_APTSPER
|
|---|
| 134 | . . DO MILADD^TMGSDAU1(.T1,TMGSDUR,.H1,.M1)
|
|---|
| 135 | SET ^SC(TMGIEN,"T",TMG1DATE,0)=TMG1DATE
|
|---|
| 136 | ;" -- Set subsubfile header --
|
|---|
| 137 | SET ^SC(TMGIEN,"T",TMG1DATE,2,0)="^44.004A^"_COUNT_"^"_COUNT
|
|---|
| 138 | ;
|
|---|
| 139 | ;" -- Set subfile header --
|
|---|
| 140 | NEW DATE SET DATE=0
|
|---|
| 141 | NEW COUNT SET COUNT=0
|
|---|
| 142 | NEW LAST SET LAST=0
|
|---|
| 143 | FOR SET DATE=+$ORDER(^SC(TMGIEN,"T",DATE)) QUIT:(DATE'>0) DO
|
|---|
| 144 | . SET LAST=DATE
|
|---|
| 145 | . SET COUNT=COUNT+1
|
|---|
| 146 | SET $PIECE(^SC(TMGIEN,"T",0),"^",3)=LAST
|
|---|
| 147 | SET $PIECE(^SC(TMGIEN,"T",0),"^",4)=COUNT
|
|---|
| 148 | ;
|
|---|
| 149 | QUIT
|
|---|
| 150 | ;
|
|---|
| 151 | ;
|
|---|
| 152 | KILLAVAL(TMGIEN,TMG1DATE,TMGLIMDT,TMGFLAGS)
|
|---|
| 153 | ;"Purpose: Delete AVAILABILITY ("T") node, and any linked "ST" and "OST" nodes.
|
|---|
| 154 | ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
|
|---|
| 155 | ;" TMG1DATE -- Starting date of a range to put entry into
|
|---|
| 156 | ;" TMGLIMDT -- Limit date of date range.
|
|---|
| 157 | ;" TMGFLAGS -- flags
|
|---|
| 158 | ;"Globally Scoped vars used: ...
|
|---|
| 159 | ;"Note: It is presumed record locking has already occured
|
|---|
| 160 | ;
|
|---|
| 161 | ;"Only delete "2" subnode. Leave "0" node in place to prevent extending
|
|---|
| 162 | ;"date range of entry occuring before this one.
|
|---|
| 163 | ;"Only delete entries falling on same day of week as TMG1DATE
|
|---|
| 164 | ;
|
|---|
| 165 | IF TMGFLAGS["R" DO
|
|---|
| 166 | . NEW DATE SET DATE=TMG1DATE
|
|---|
| 167 | . FOR DO SET DATE=$$ADD2DATE^TMGSDAU1(DATE,7) QUIT:(DATE'<TMGLIMDT)!(DATE'<DT+50000)
|
|---|
| 168 | . . DO KILL1DATE(TMGIEN,DATE)
|
|---|
| 169 | ELSE DO
|
|---|
| 170 | . DO KILL1DATE(TMGIEN,TMG1DATE)
|
|---|
| 171 | QUIT
|
|---|
| 172 | ;
|
|---|
| 173 | ;
|
|---|
| 174 | KILL1DATE(TMGIEN,TMG1DATE,FULL)
|
|---|
| 175 | ;"Purpose: To remove 1 "T" node, and any linked ST and OST nodes
|
|---|
| 176 | ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
|
|---|
| 177 | ;" TMG1DATE -- the date to remove
|
|---|
| 178 | ;" FULL -- OPTIONAL. if 1 then entire T node removed, otherwise 0 node is left.
|
|---|
| 179 | ;"Globally-scoped var used: ...
|
|---|
| 180 | ;"Note: It is presumed record locking has already occured
|
|---|
| 181 | KILL ^SC(TMGIEN,"T",DATE,2)
|
|---|
| 182 | IF $DATA(^SC(TMGIEN,"ST",DATE)) DO
|
|---|
| 183 | . IF $DATA(^SC(TMGIEN,"ST",DATE,9)) DO
|
|---|
| 184 | . . KILL ^SC(TMGIEN,"OST",DATE)
|
|---|
| 185 | . KILL ^SC(TMGIEN,"ST",DATE)
|
|---|
| 186 | IF $GET(FULL)=1 KILL ^SC(TMGIEN,"T",DATE)
|
|---|
| 187 | QUIT
|
|---|
| 188 | ;
|
|---|
| 189 | ;
|
|---|
| 190 | AVAIL4DAT(TMGIEN,TMG1DATE,PARRAY)
|
|---|
| 191 | ;"Purpose: To generage an array with slot time data for a given date, based on templates
|
|---|
| 192 | ;" This PARRAY could be suitable for generating a "T" node entry
|
|---|
| 193 | ;"Input: TMGIEN -- IEN in HOSPITAL LOCATION file.
|
|---|
| 194 | ;" TMG1DATE -- the appointment date to look up. Don't pass by reference
|
|---|
| 195 | ;" PARRAY -- PASS BY NAME. An OUT PARAMETER (prior contents killed)
|
|---|
| 196 | ;" Output format: Array containing time data. e.g.:
|
|---|
| 197 | ;" @PARRAY@("0800-0810")=2
|
|---|
| 198 | ;" @PARRAY@("0830-0850")=1
|
|---|
| 199 | ;" @PARRAY@("0900-0930")=1
|
|---|
| 200 | ;" @PARRAY@("1000-1140")=1
|
|---|
| 201 | ;"Results: 1=success, -1^Msg=error
|
|---|
| 202 | ;"Output: @PARRAY is filled as above
|
|---|
| 203 | ;
|
|---|
| 204 | NEW TMGRESULT SET TMGRESULT=1 ;"Default to success
|
|---|
| 205 | SET TMG1DATE=TMG1DATE\1
|
|---|
| 206 | KILL @PARRAY
|
|---|
| 207 | ;
|
|---|
| 208 | ;"First see if a Special pattern exists for date in "OST" note
|
|---|
| 209 | NEW STR SET STR=$GET(^SC(TMGIEN,"OST",TMG1DATE,1))
|
|---|
| 210 | IF STR'="" DO GOTO A4DDONE
|
|---|
| 211 | . SET STR=$PIECE(STR,"|",2,999)
|
|---|
| 212 | . DO STR2PAT(TMGIEN,STR,PARRAY)
|
|---|
| 213 | ;
|
|---|
| 214 | ;"FIND APPLICABLE TEMPLATE (Tx NODE)
|
|---|
| 215 | NEW DOW SET DOW=$$DOW^XLFDT(TMG1DATE,1) ;"DOW=Day of Week (0-6)
|
|---|
| 216 | NEW DATE SET DATE=TMG1DATE
|
|---|
| 217 | SET DATE=$ORDER(^SC(TMGIEN,"T"_DOW,TMG1DATE))
|
|---|
| 218 | IF DATE="" DO GOTO A4DDONE
|
|---|
| 219 | . SET TMGRESULT="-1^NO TEMPLATE FOUND FOR DATE"
|
|---|
| 220 | SET STR=$GET(^SC(TMGIEN,"T"_DOW,DATE,1))
|
|---|
| 221 | IF STR="" DO GOTO A4DDONE
|
|---|
| 222 | . SET TMGRESULT="-1^NO VALID TEMPLATE FOUND FOR DATE"
|
|---|
| 223 | DO STR2PAT(TMGIEN,STR,PARRAY)
|
|---|
| 224 | ;
|
|---|
| 225 | A4DDONE QUIT TMGRESULT
|
|---|
| 226 | ;
|
|---|
| 227 | ;
|
|---|
| 228 | STR2PAT(TMGIEN,STR,PARRAY)
|
|---|
| 229 | ;"Purpose: Convert a template pattern into an array of times.
|
|---|
| 230 | ;"Input: TMGIEN -- IEN in file 44
|
|---|
| 231 | ;" STR -- Template pattern (Note that DAY DATE is *NOT* at beginning of line)
|
|---|
| 232 | ;" E.g. | [1] [1 1 1 1 1] [1 1 1 1 1] | | [1] [1 1] [1 1 1 1 1] [1 1 1 1 1] [1 1 1] "
|
|---|
| 233 | ;" PARRAY -- PASS BY NAME. An OUT PARAMETER (prior contents killed)
|
|---|
| 234 | ;" Output format: Array containing time data. e.g.:
|
|---|
| 235 | ;" @PARRAY@("0800-0810")=2
|
|---|
| 236 | ;" @PARRAY@("0830-0850")=1
|
|---|
| 237 | ;" @PARRAY@("0900-0930")=1
|
|---|
| 238 | ;" @PARRAY@("1000-1140")=1
|
|---|
| 239 | ;"Globally-scoped vars used: ...
|
|---|
| 240 | ;"Result: 1 if OK, -1 if error
|
|---|
| 241 | ;
|
|---|
| 242 | NEW TMGRESULT SET TMGRESULT=1 ;"Default to success
|
|---|
| 243 | SET STR=$GET(STR) IF STR="" SET TMGRESULT=-1 GOTO S2PDONE
|
|---|
| 244 | SET PARRAY=$GET(PARRAY) IF PARRAY="" SET TMGRESULT=-1 GOTO S2PDONE
|
|---|
| 245 | ;
|
|---|
| 246 | NEW TMGSPH SET TMGSPH=+$P($GET(^SC(TMGIEN,"SL")),"^",6) ;"SL;6 = DISPLAY INCS PER HOUR (Slots per Hr)
|
|---|
| 247 | IF TMGSPH'>0 SET TMGSPH=4 ;"Default to 4 slots/hr
|
|---|
| 248 | NEW APTLEN SET APTLEN=60\TMGSPH ;"Minutes length of each slot
|
|---|
| 249 | NEW STARTDAY SET STARTDAY=+$P($GET(^SC(TMGIEN,"SL")),"^",3) ;"SL;3=HR CLINIC DISPLAY BEGINS
|
|---|
| 250 | SET STARTDAY=STARTDAY_"00" ;"Make into military time, e.g. 8am --> 0800
|
|---|
| 251 | FOR QUIT:$LENGTH(STARTDAY)'<4 SET STARTDAY="0"_STARTDAY
|
|---|
| 252 | NEW STRLEN SET STRLEN=$LENGTH(STR)
|
|---|
| 253 | NEW IDX FOR IDX=2:2:STRLEN DO
|
|---|
| 254 | . NEW TIME1,TIME2,HRS,MINS,CH,NUMAVAIL
|
|---|
| 255 | . SET CH=$EXTRACT(STR,IDX)
|
|---|
| 256 | . IF (CH="")!(CH=" ") QUIT
|
|---|
| 257 | . ;"CONVERT CH INFO NUMAVAIL
|
|---|
| 258 | . SET NUMAVAIL=$$CH2NAVAL(CH)
|
|---|
| 259 | . IF NUMAVAIL'>0 QUIT
|
|---|
| 260 | . SET TIME1=((IDX-2)/2)/TMGSPH
|
|---|
| 261 | . SET TIME1=$$FRAC2TIM(TIME1)
|
|---|
| 262 | . SET TIME1=$$MILADD2^TMGSDAU1(TIME1,STARTDAY) ;"add 2 times
|
|---|
| 263 | . DO MILADD^TMGSDAU1(TIME1,APTLEN,.HRS,.MINS) ;"add time + mins
|
|---|
| 264 | . NEW TEMP SET TEMP=TIME1_"-"_HRS_MINS
|
|---|
| 265 | . SET @PARRAY@(TEMP)=NUMAVAIL
|
|---|
| 266 | ;
|
|---|
| 267 | S2PDONE ;
|
|---|
| 268 | QUIT TMGRESULT
|
|---|
| 269 | ;
|
|---|
| 270 | ;
|
|---|
| 271 | FRAC2TIM(TIME,HRS,MINS)
|
|---|
| 272 | ;"Purpose: Convert Fractional time --> Hrs & Min e.g. 3.75 --> 3 & 45 (i.e. 3:45)
|
|---|
| 273 | ;"Input: TIME: Time in fractional format. E.g. 3.75
|
|---|
| 274 | ;" HRS -- PASS BY REFERENCE. An OUT PARAMETER. Set to be resulting hours
|
|---|
| 275 | ;" will ensure length it 2 digits. i.e. 1 --> 01
|
|---|
| 276 | ;" MINS -- PASS BY REFERENCE. An OUT PARAMETER. Set to be minutes minutes
|
|---|
| 277 | ;" will ensure length it 2 digits. i.e. 1 --> 01
|
|---|
| 278 | ;"Result: result in military format
|
|---|
| 279 | SET HRS=TIME\1 ;"Get just hrs part
|
|---|
| 280 | SET MINS=TIME#1 ;"Get just minutes part, e.g. 0.3 (i.e. 30 minutes)
|
|---|
| 281 | SET MINS=(MINS*0.6)*100 ;"convert .75 -> .45, * 100 = 45 minutes
|
|---|
| 282 | FOR QUIT:$LENGTH(MINS)>1 SET MINS="0"_MINS
|
|---|
| 283 | FOR QUIT:$LENGTH(HRS)>1 SET HRS="0"_HRS
|
|---|
| 284 | ;
|
|---|
| 285 | QUIT HRS_MINS
|
|---|
| 286 | ;
|
|---|
| 287 | ;
|
|---|
| 288 | CH2NAVAL(CH)
|
|---|
| 289 | ;"Purpose: convert a given availability character into number of slots there.
|
|---|
| 290 | NEW CODES SET CODES="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
|
|---|
| 291 | QUIT $FIND(CODES,CH)-$FIND(CODES,"0")
|
|---|
| 292 | ;
|
|---|
| 293 | ; |
|---|
