| [796] | 1 | TMGSDAM2 ;TMG/kst/ENHANCED MAKE AN APPOINTMENT SDAPI ;1/9/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;1/9/09
|
|---|
| 3 | ;
|
|---|
| 4 | ;"NOTE: Original header:
|
|---|
| 5 | ;"SDVWMKPI ;ENHANCED MAKE AN APPOINTMENT SDAPI 11/18/06
|
|---|
| 6 | ;" ;VWSD*3.2;;;;;Build 8
|
|---|
| 7 | ;"(Moved to this namespace for customization/alteration)
|
|---|
| 8 | ;
|
|---|
| 9 | ;"Called into from TMGRPC5
|
|---|
| 10 | ;
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;" API -- Public Functions.
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;"EN(DFN,APPTDATE,SC,STYP,SDARRAY) -- MAKE AN APPOINTMENT
|
|---|
| 15 | ;
|
|---|
| 16 | ;"=======================================================================
|
|---|
| 17 | ;" API -- Public Functions.
|
|---|
| 18 | ;"=======================================================================
|
|---|
| 19 | ;"CHKAVAIL(SAVE,APPTDATE)
|
|---|
| 20 | ;
|
|---|
| 21 | ;"=======================================================================
|
|---|
| 22 | ;"Dependancies
|
|---|
| 23 | ;"=======================================================================
|
|---|
| 24 | ;
|
|---|
| 25 | ;"=======================================================================
|
|---|
| 26 | ;
|
|---|
| 27 | EN(DFN,APPTDATE,SC,STYP,SDARRAY) ;
|
|---|
| 28 | ;"Purpose: MAKE AN APPOINTMENT
|
|---|
| 29 | ;"INPUT: DFN -- PATIENT IEN (REQUIRED)
|
|---|
| 30 | ;" APPTDATE -- APPOINTMENT DATE (REQUIRED) -- FM format
|
|---|
| 31 | ;" SC -- IEN of CLINIC FOR APPOINTMENT (REQUIRED) (file 44)
|
|---|
| 32 | ;" STYP (REQUIRED)
|
|---|
| 33 | ;" =1 C&P
|
|---|
| 34 | ;" =2 10-10
|
|---|
| 35 | ;" =3 SCHEDULED APPOINTMENT
|
|---|
| 36 | ;" =4 UNSCHEDULED VISIT
|
|---|
| 37 | ;" SDARRAY -- PASS BY REFERENCE. Format:
|
|---|
| 38 | ;" SDARRAY("DATE NOW") (REQ AT TIME REQUEST MADE) (OPTIONAL. Defaults to NOW is not provide)
|
|---|
| 39 | ;" SDARRAY("LAB DATE TIME ASSOCIATED") = "" OR DATE/TIME (OPTIONAL)
|
|---|
| 40 | ;" SDARRAY("X-RAY DATE TIME ASSOCIATED") = "" OR DATE/TIME (OPTIONAL)
|
|---|
| 41 | ;" SDARRAY("EKG DATE TIME ASSOCIATED") = "" OR DATE/TIME (OPTIONAL)
|
|---|
| 42 | ;" SDARRAY("APPT TYPE") = 9 (REQUIRED)
|
|---|
| 43 | ;" 9 for REGULAR APPOINTMENT TYPE (ptr 409.1)
|
|---|
| 44 | ;" SDARRAY("APPT SUB-CATEGORY") = "0" (NOT USED)
|
|---|
| 45 | ;" "0" for none (ptr 35.2)
|
|---|
| 46 | ;" SDARRAY("SCHED_REQ_TYPE")='O' (REQUIRED)
|
|---|
| 47 | ;" 'O' FOR OTHER THAN 'NEXT AVA.' APPT.; (set of codes)
|
|---|
| 48 | ;" --I think this is for File 2, field 1900, subfield 25
|
|---|
| 49 | ;" N:'NEXT AVAILABLE' APPT.
|
|---|
| 50 | ;" C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)
|
|---|
| 51 | ;" P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.)
|
|---|
| 52 | ;" W:WALKIN APPT.
|
|---|
| 53 | ;" M:MULTIPLE APPT. BOOKING
|
|---|
| 54 | ;" A:AUTO REBOOK
|
|---|
| 55 | ;" O:OTHER THAN 'NEXT AVA.' APPT.
|
|---|
| 56 | ;" SDARRAY("NEXT APPT IND")=0 (REQUIRED) (0 FOR NO)
|
|---|
| 57 | ;" SDARRAY("DESIRED DATE TIME OF APPT")=APPTDATE (OPTIONAL)
|
|---|
| 58 | ;" SDARRAY("FOLLOWUP VISIT INDICATOR")= (REQUIRED)
|
|---|
| 59 | ;" "0" FOR NO
|
|---|
| 60 | ;" "1" FOR YES
|
|---|
| 61 | ;" SDARRAY("X RAY DATA FREE TEXT")= (OPTIONAL)
|
|---|
| 62 | ;" SDARRAY("OTHER DATA FREE TEXT")= (OPTIONAL)
|
|---|
| 63 | ;" SDARRAY("OTHER WARD LOCATION")= (OPTIONAL)
|
|---|
| 64 | ;" SDARRAY("DATA ENTRY CLERK")= (DEFAULTS TO DUZ IF NOT PROVIDED)
|
|---|
| 65 | ;" DUZ OR NEW PERSON (FILE 200) PTR
|
|---|
| 66 | ;" SDARRAY("PRIOR XRAY RESULTS TO CLINIC")= (OPTIONAL)
|
|---|
| 67 | ;" "Y" OR ""
|
|---|
| 68 | ;" SDARRAY("CHECKED-IN DATE")= (OPTIONAL)
|
|---|
| 69 | ;" "" OR DATE APPOINTMENT MADE
|
|---|
| 70 | ;" FOR AN UNSCHEDULED VISIT
|
|---|
| 71 | ;"
|
|---|
| 72 | ;"XQSDVWSI ; EXIST AS NON-INTERACTIVE SILENT NODE W/O WRITE FOR XQOR ROUTINES
|
|---|
| 73 | ;"SDVWNVAI ; EXIST AS NON-VA RELATED PFSS EVENT MODE
|
|---|
| 74 | ;" = "D" DISABLING THE NEED FOR ICN
|
|---|
| 75 | ;" = "O" AS OTHER NON-VA ICN SYSTEM ( FUTURE)
|
|---|
| 76 | ;"
|
|---|
| 77 | ;"RESULTS: 1 = OK,APPOINTMENT SUCCESSFULLY MADE
|
|---|
| 78 | ;" NEG NUMBER= ERROR
|
|---|
| 79 | ;" -101 INVALID PATIENT DFN
|
|---|
| 80 | ;" -102 INVALID HOSPITAL LOCATION IEN (SC)
|
|---|
| 81 | ;" -103 APPTDATE < DATE NOW
|
|---|
| 82 | ;" -104 INVALID STYP or MODE
|
|---|
| 83 | ;" // (removed) -105 IF $GET(SDARRAY("DATE NOW"))=""
|
|---|
| 84 | ;" -106 IF $GET(SDARRAY("APPT TYPE"))=""
|
|---|
| 85 | ;" -107 IF $GET(SDARRAY("SCHED_REQ_TYPE"))=""
|
|---|
| 86 | ;" -108 IF $GET(SDARRAY("NEXT APPT IND"))=""
|
|---|
| 87 | ;" // (removed) -109 IF $GET(SDARRAY("DATA ENTRY CLERK"))=""
|
|---|
| 88 | ;" -110 IF $GET(SDARRAY("FOLLOWUP VISIT INDICATOR")=""
|
|---|
| 89 | ;" -111 NO SCHEDULED SLOT WHERE SCHED APPT IS WANTED
|
|---|
| 90 | ;
|
|---|
| 91 | N TIMEDD
|
|---|
| 92 | N SDCL,SDT,SDDA,SDMODE,SDORG
|
|---|
| 93 | N CNT,SDY,DAYW,NDOW,TMG1DATE,FOUND,VAL,MULTM,START,INCRM
|
|---|
| 94 | N APTTIME,OV2,VAL2
|
|---|
| 95 | N SDSL,SL,SDSDATE,STARTDAY,SDHDL,SDEMP,SDMKHDL,SDMADE,SDLOCK,SDAPTYP,SDCOL
|
|---|
| 96 | N TMGRESULT SET TMGRESULT=1 ;"Default to success
|
|---|
| 97 | N TMGMSG
|
|---|
| 98 | ;
|
|---|
| 99 | N PURVISIT,SAVENOW,OVERBOOK,ELIGIB,OVERBOKM
|
|---|
| 100 | ;
|
|---|
| 101 | ;"VALIDATE DFN, SC AS VALID PATIENTS AND CLINIC
|
|---|
| 102 | IF '$D(^DPT(DFN,0)) SET TMGRESULT="-101^INVALID PATIENT DFN" GOTO ENDONE
|
|---|
| 103 | IF '$D(^SC(SC,0)) SET TMGRESULT="-102^INVALID HOSPITAL LOCATION IEN" GOTO ENDONE
|
|---|
| 104 | ;
|
|---|
| 105 | ;"CHECK DATE>=NOW
|
|---|
| 106 | IF $GET(SDARRAY("DATE NOW"))="" SET SDARRAY("DATE NOW")="NOW"
|
|---|
| 107 | . ;"SET TMGRESULT=-105 GOTO ENDONE
|
|---|
| 108 | SET SDARRAY("DATE NOW")=$$E2IDATE(SDARRAY("DATE NOW"))
|
|---|
| 109 | SET (SAVENOW,X)=SDARRAY("DATE NOW")
|
|---|
| 110 | IF APPTDATE<SAVENOW SET TMGRESULT="-103^APPTDATE < DATE NOW" GOTO ENDONE
|
|---|
| 111 | IF STYP=4 SET APPTDATE=X ;"If unscheduled visit, force date to NOW
|
|---|
| 112 | ;"FORMAT APPTDATE BELOW SHOULD BE FOUND IN NODE BELOW
|
|---|
| 113 | IF $GET(^SC(SC,"S",APPTDATE,0))=APPTDATE DO
|
|---|
| 114 | . SET CNT=0
|
|---|
| 115 | . FOR SET CNT=$ORDER(^SC(SC,"S",APPTDATE,1,CNT)) Q:CNT="" DO
|
|---|
| 116 | . . SET SDY=CNT+1
|
|---|
| 117 | ELSE DO
|
|---|
| 118 | . SET SDY=1
|
|---|
| 119 | IF (STYP<1)!(STYP>4) SET TMGRESULT="-104^INVALID STYP or MODE" GOTO ENDONE
|
|---|
| 120 | ;
|
|---|
| 121 | IF $GET(SDARRAY("DATA ENTRY CLERK"))="" DO
|
|---|
| 122 | . SET SDARRAY("DATA ENTRY CLERK")=DUZ
|
|---|
| 123 | . ;"SET TMGRESULT=-109 GOTO ENDONE
|
|---|
| 124 | ;
|
|---|
| 125 | ;"CHECK OTHER REQUIRED VARIABLES
|
|---|
| 126 | IF $GET(SDARRAY("APPT TYPE"))="" DO GOTO ENDONE
|
|---|
| 127 | . SET TMGRESULT="-106^APPT TYPE NOT SPECIFIED"
|
|---|
| 128 | IF $GET(SDARRAY("SCHED_REQ_TYPE"))="" DO GOTO ENDONE
|
|---|
| 129 | . SET TMGRESULT="-107^SCHED REQ TYPE NOT SPECIFIED"
|
|---|
| 130 | IF $GET(SDARRAY("NEXT APPT IND"))="" DO GOTO ENDONE
|
|---|
| 131 | . SET TMGRESULT="-108^NEXT APPT IND NOT SPECIFIED"
|
|---|
| 132 | IF $GET(SDARRAY("FOLLOWUP VISIT INDICATOR"))="" DO GOTO ENDONE
|
|---|
| 133 | . SET TMGRESULT="-110^FOLLOWUP VISIT INDICATOR NOT SPECIFIED"
|
|---|
| 134 | ;
|
|---|
| 135 | ;"ENSURE EXISTANCE OF VARIABLES / CONVERT DATES IF NEEDED
|
|---|
| 136 | SET SDARRAY("CHECKED-IN DATE")=$$E2IDATE($GET(SDARRAY("CHECKED-IN DATE")))
|
|---|
| 137 | SET SDARRAY("LAB DATE TIME ASSOCIATED")=$$E2IDATE($GET(SDARRAY("LAB DATE TIME ASSOCIATED")))
|
|---|
| 138 | SET SDARRAY("X-RAY DATE TIME ASSOCIATED")=$$E2IDATE($GET(SDARRAY("X-RAY DATE TIME ASSOCIATED")))
|
|---|
| 139 | SET SDARRAY("EKG DATE TIME ASSOCIATED")=$$E2IDATE($GET(SDARRAY("EKG DATE TIME ASSOCIATED")))
|
|---|
| 140 | SET SDARRAY("APPT TYPE")=$GET(SDARRAY("APPT TYPE"))
|
|---|
| 141 | SET SDARRAY("SCHED_REQ_TYPE")=$GET(SDARRAY("SCHED_REQ_TYPE"))
|
|---|
| 142 | SET SDARRAY("NEXT APPT IND")=$GET(SDARRAY("NEXT APPT IND"))
|
|---|
| 143 | SET SDARRAY("DESIRED DATE TIME OF APPT")=$$E2IDATE($GET(SDARRAY("DESIRED DATE TIME OF APPT")))
|
|---|
| 144 | SET SDARRAY("FOLLOWUP VISIT INDICATOR")=$GET(SDARRAY("FOLLOWUP VISIT INDICATOR"))
|
|---|
| 145 | SET SDARRAY("FOLLOWUP VISIT INDICATOR")=$GET(SDARRAY("FOLLOWUP VISIT INDICATOR"))
|
|---|
| 146 | ;
|
|---|
| 147 | SET OV2=0
|
|---|
| 148 | IF STYP'=4 DO ;"i.e. 1 (C&P), 2 (10-10), or 3 (SCHEDULED APPOINTMENT)
|
|---|
| 149 | . ;"BEFORE MAKE APPT
|
|---|
| 150 | . ;"THIS MAY ALSO DO CHECKIN AN APPOINTMENT
|
|---|
| 151 | . ;"ALSO NEED TO CHECK AGAINST SCHEDULE FOR THAT DAY
|
|---|
| 152 | . ;"DETERMINE LAST RELATIVE ENTRY # FOR
|
|---|
| 153 | . ;"THIS APPOINTMENT DATE (IF ANY) ON THIS CLINIC
|
|---|
| 154 | . ;
|
|---|
| 155 | . ;"TO SEE IF OVERBOOK MAX ACHIEVED OR APPOINTMENT NOT AVAILABLE
|
|---|
| 156 | . ;"FOR THAT TIME AND DATE.
|
|---|
| 157 | . ;"GET DATE
|
|---|
| 158 | . SET APTTIME=$P(APPTDATE,".",2) ;"get just time
|
|---|
| 159 | . FOR Q:$L(APTTIME)>3 SET APTTIME=APTTIME_"0" ;"PAD OUT TIME TO 4 DIGITS
|
|---|
| 160 | . ;"CHECK WHAT MULTIPLE OF DAY OF WEEK FOR APPOINTMENT START
|
|---|
| 161 | . ;"GET DAY OF WEEK
|
|---|
| 162 | . SET X=APPTDATE DO DW^%DTC IF X="" QUIT ;"Must be invalid date
|
|---|
| 163 | . SET DAYW=$E(X,1,2) ;"e.g. MO for MONDAY
|
|---|
| 164 | . SET DOW=$$DOW^XLFDT(APPTDATE,1) ;"DOW=Day of Week (0-6)
|
|---|
| 165 | . ;"FIND DAY OF WEEK ENTRY IN "ST" MULT , THEN FIND STARTING TIME AND
|
|---|
| 166 | . ;"TIME MATCH IN SAME "T" MULT.
|
|---|
| 167 | . SET TMG1DATE=APPTDATE\1
|
|---|
| 168 | . SET FOUND=0
|
|---|
| 169 | . FOR DO SET TMG1DATE=$ORDER(^SC(SC,"ST",TMG1DATE),-1) QUIT:(+TMG1DATE'>0)!(FOUND=1)
|
|---|
| 170 | . . SET VAL=$GET(^SC(SC,"ST",TMG1DATE,1)) ;" e.g. MO 05 | [1 1|0 1 1 1|1 1 1 1|1 1] "
|
|---|
| 171 | . . IF ($E(VAL,1,2)'=DAYW) QUIT ;"Skip if null, or not matching day of week
|
|---|
| 172 | . . IF $$CHKAVAIL(TMG1DATE,APTTIME)=0 QUIT
|
|---|
| 173 | . . SET FOUND=1
|
|---|
| 174 | . . SET INCR=0
|
|---|
| 175 | . . ;"Now find T node that applies to APPTDATE
|
|---|
| 176 | . . NEW TEMPDATE SET TEMPDATE=TMG1DATE
|
|---|
| 177 | . . FOR DO QUIT:(OV2=1) SET TEMPDATE=$ORDER(^SC(SC,"T",TEMPDATE),-1) QUIT:(+TEMPDATE'>0)
|
|---|
| 178 | . . . IF $DATA(^SC(SC,"T",TEMPDATE))=0 QUIT
|
|---|
| 179 | . . . IF $$DOW^XLFDT(TEMPDATE,1)'=DOW QUIT
|
|---|
| 180 | . . . FOR SET INCR=$ORDER(^SC(SC,"T",TEMPDATE,2,INCR)) QUIT:(INCR="")!(OV2=1) DO
|
|---|
| 181 | . . . . SET VAL2=$GET(^SC(SC,"T",TEMPDATE,2,INCR,0)) ;"e.g. 0830^1
|
|---|
| 182 | . . . . SET VAL2=$PIECE(VAL2,"^",1)
|
|---|
| 183 | . . . . IF VAL2=APTTIME SET OV2=1
|
|---|
| 184 | . IF OV2=1 DO
|
|---|
| 185 | . . ;"NOW CHECK IN "S" ARRAY TO SEE IF APPT ALREADY MADE
|
|---|
| 186 | . . IF SDY'=1 DO ;"Should this be SDY>1 DO ??
|
|---|
| 187 | . . . ;"CHECK IF OVERBOOKS ALLOWED
|
|---|
| 188 | . . . IF $PIECE($GET(^SC(SC,"SL")),"^",7)=0 SET OV2=0
|
|---|
| 189 | ELSE DO ;"i.e. STYP=4 UNSCHEDULED VISIT
|
|---|
| 190 | . ;"ALSO
|
|---|
| 191 | . SET OV2=1
|
|---|
| 192 | ;
|
|---|
| 193 | IF OV2'=1 DO GOTO ENDONE
|
|---|
| 194 | . SET TMGRESULT="-111^NO SCHEDULED SLOT WHERE SCHED APPT IS WANTED"
|
|---|
| 195 | ;
|
|---|
| 196 | SET SDCL=SC
|
|---|
| 197 | SET SDT=APPTDATE
|
|---|
| 198 | SET SDDA=SDY
|
|---|
| 199 | SET SDMODE=2
|
|---|
| 200 | SET SDORG=1
|
|---|
| 201 | ;"ADDITIONAL
|
|---|
| 202 | SET SL=$P(^SC(SC,"SL"),"^",1)
|
|---|
| 203 | SET SDSDATE=APPTDATE
|
|---|
| 204 | ;"SET STARTDAY
|
|---|
| 205 | ;
|
|---|
| 206 | ;"START PREPARING DATA FROM SDARRAY INTO NODES
|
|---|
| 207 | ;
|
|---|
| 208 | ;"FIRST INITIAL TOP NODE FOR APPOINTMENT SUB-FILE
|
|---|
| 209 | SET ^DPT(DFN,"S",0)="^2.98P^^"
|
|---|
| 210 | LOCK +^DPT(DFN,"S",0):5
|
|---|
| 211 | ;"NEXT NODE 0
|
|---|
| 212 | SET PURVISIT=STYP
|
|---|
| 213 | SET TIMEDD=$P(APPTDATE,".",1)
|
|---|
| 214 | NEW TEMPS
|
|---|
| 215 | SET TEMPS=SC_"^^"_SDARRAY("LAB DATE TIME ASSOCIATED")_"^"
|
|---|
| 216 | SET TEMPS=TEMPS_SDARRAY("X-RAY DATE TIME ASSOCIATED")_"^"
|
|---|
| 217 | SET TEMPS=TEMPS_SDARRAY("EKG DATE TIME ASSOCIATED")
|
|---|
| 218 | SET ^DPT(DFN,"S",APPTDATE,0)=TEMPS
|
|---|
| 219 | SET TEMPS=^DPT(DFN,"S",APPTDATE,0)_"^^"_PURVISIT
|
|---|
| 220 | SET TEMPS=TEMPS_"^^^^^^^^^"_SDARRAY("APPT TYPE")_"^^^"_TIMEDD_"^^^^^"_0
|
|---|
| 221 | SET ^DPT(DFN,"S",APPTDATE,0)=TEMPS
|
|---|
| 222 | SET TEMPS=^DPT(DFN,"S",APPTDATE,0)_"^"_SDARRAY("SCHED_REQ_TYPE")_"^"
|
|---|
| 223 | SET TEMPS=TEMPS_SDARRAY("NEXT APPT IND")
|
|---|
| 224 | SET ^DPT(DFN,"S",APPTDATE,0)=TEMPS
|
|---|
| 225 | ;"NEXT NODE 1
|
|---|
| 226 | IF SDARRAY("DESIRED DATE TIME OF APPT")'="" DO
|
|---|
| 227 | . SET ^DPT(DFN,"S",APPTDATE,1)=SDARRAY("DESIRED DATE TIME OF APPT")_"^"_SDARRAY("FOLLOWUP VISIT INDICATOR")
|
|---|
| 228 | ELSE DO
|
|---|
| 229 | . SET ^DPT(DFN,"S",APPTDATE,1)=TIMEDD_"^"_SDARRAY("FOLLOWUP VISIT INDICATOR")
|
|---|
| 230 | LOCK -^DPT(DFN,"S",0)
|
|---|
| 231 | ;"NOW FILE 44 MULTIPLE IN APPOINTMENT SUB-FILE
|
|---|
| 232 | ;"FIRST TOP NODE IN CLINIC FOR DATE
|
|---|
| 233 | SET ^SC(SC,"S",0)="^44.001DA^^"
|
|---|
| 234 | LOCK +^SC(SC,"S",0):5
|
|---|
| 235 | ;"NEXT DATE MULTIPLE
|
|---|
| 236 | SET ^SC(SC,"S",APPTDATE,0)=APPTDATE
|
|---|
| 237 | ;"NEXT TOP NODE UNDER DATE FOR PATIENT
|
|---|
| 238 | SET ^SC(SC,"S",APPTDATE,1,0)="^44.003PA^^"
|
|---|
| 239 | ;"NEXT MULTIPLE ENTRY PER PATIENT
|
|---|
| 240 | SET ^SC(SC,"S",APPTDATE,1,SDY,0)=DFN_"^"_SL_"^"_$GET(SDARRAY("X RAY DATA FREE TEXT"))_"^"_$GET(SDARRAY("OTHER DATA FREE TEXT"))_"^"_$GET(SDARRAY("OTHER WARD LOCATION"))
|
|---|
| 241 | SET ^SC(SC,"S",APPTDATE,1,SDY,0)=^SC(SC,"S",APPTDATE,1,SDY,0)_"^"_$GET(SDARRAY("DATA ENTRY CLERK"))_"^"_SAVENOW
|
|---|
| 242 | IF STYP=4 SET ^SC(SC,"S",APPTDATE,1,SDY,0)=^SC(SC,"S",APPTDATE,1,SDY,0)_"^"_$GET(SDARRAY("PRIOR X-RAY RESULTS TO CLINIC"))
|
|---|
| 243 | ;
|
|---|
| 244 | ;"Change PATTERN ("ST") nodes to reflext currently available slots.
|
|---|
| 245 | IF $$ENSUR1ST^TMGSDAU(SC,APPTDATE,.TMGMSG)'=1 DO ;"Create ST node, if doesn't exist
|
|---|
| 246 | . SET TMGRESULT="-200^"_$GET(TMGMSG(1)) KILL TMGMSG
|
|---|
| 247 | IF $$DEC1SLOT^TMGSDAU(SC,APPTDATE,.TMGMSG)=-1 DO ;"Don't quit, appt was made-->so trigger event
|
|---|
| 248 | . SET TMGRESULT="-200^Error updating PATTERN (ST nodes). "_$GET(TMGMSG(1))
|
|---|
| 249 | . KILL TMGMSG
|
|---|
| 250 | ;
|
|---|
| 251 | ;"DETERMINE ANY OVERBOOK AND ELIGIBILITY HERE
|
|---|
| 252 | SET OVERBOKM=$P(^SC(SC,"SL"),"^",7)
|
|---|
| 253 | IF SDY>OVERBOKM DO
|
|---|
| 254 | . SET OVERBOOK="O"
|
|---|
| 255 | . SET ^SC(SC,"S",APPTDATE,1,SDY,"OB")="0"
|
|---|
| 256 | ELSE DO
|
|---|
| 257 | . SET OVERBOOK=""
|
|---|
| 258 | ;"ELIGIBILITY NEXT
|
|---|
| 259 | DO ELIG^VADPT SET ELIGIB=$P(VAEL(1),"^",1)
|
|---|
| 260 | IF STYP=4 SET ^SC(SC,"S",APPTDATE,1,SDY,0)=^SC(SC,"S",APPTDATE,1,SDY,0)_"^"_"^"_"^"_ELIGIB
|
|---|
| 261 | ;"NOW UNSCHEDULED VISITS EXTRA DATA
|
|---|
| 262 | ;"REALLY LATER MAY NEED ELIGIBILITY FOR NON-VA SYSTEMS PATIENTS WITH
|
|---|
| 263 | ;"SCHEDULED APPTS AND UNSCHEDULED VISITS ( HUMANITARIAN, REIMBURSABLE INSURANCE, ETC)
|
|---|
| 264 | IF STYP=4 DO
|
|---|
| 265 | .SET ^SC(SC,"S",APPTDATE,1,SDY,"C")=SD_"^"_$GET(SDARRAY("DATA ENTRY CLERK"))_"^^^"_SD
|
|---|
| 266 | LOCK -^SC(SC,"S",0)
|
|---|
| 267 | ;"EVENT GENERATION ALSO FOR PFSS SYSTEM WHICH CAN BE USED WITH AN EXTERNAL SCHEDULING SYSTEM
|
|---|
| 268 | ;"FOR MAKE APPT EVENTS AS WELL AS CHECKIN,CHECKOUT,CANCEL,DELETE, AND OUTPATIENT ENCOUNTER DATA
|
|---|
| 269 | DO MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
|
|---|
| 270 | ENDONE ;
|
|---|
| 271 | QUIT TMGRESULT
|
|---|
| 272 | ;
|
|---|
| 273 | ;
|
|---|
| 274 | CHKAVAIL(TMG1DATE,APTTIME) ;
|
|---|
| 275 | ;"Purpose: CHECK IF SLOT ALLOWED FOR THAT DAY/TIME SLOT
|
|---|
| 276 | ;"Input TMG1DATE -- DATE in FM format to check on.
|
|---|
| 277 | ;" APTTIME -- Time of appt, in military format, e.g. '1345'
|
|---|
| 278 | ;"Globally Scoped Vars used: SC - IEN in 44
|
|---|
| 279 | ;"Results: 0 -- not available
|
|---|
| 280 | ;" 1 -- available
|
|---|
| 281 | ;
|
|---|
| 282 | N SL,VAL,DATE,STARTTIM,SL,POS,COUNT
|
|---|
| 283 | NEW CODES SET CODES="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
|
|---|
| 284 | ;
|
|---|
| 285 | SET SL=$P($GET(^SC(SC,"SL")),"^",1) ;"LENGTH OF APPT
|
|---|
| 286 | SET VAL=$GET(^SC(SC,"ST",TMG1DATE,1)) ;" e.g. 'MO 05 | [1 1|0 1 1 1|1 1 1 1|1 1] '
|
|---|
| 287 | ;"START AT 9TH PIECE TO SEE IF NON-BLANK
|
|---|
| 288 | ;"FORMAT DATE+STARTTIME
|
|---|
| 289 | SET STARTTIM=$P($GET(^SC(SC,"SL")),"^",3) ;"DISPLAY START TIME
|
|---|
| 290 | IF $L(STARTTIM)=1 SET STARTTIM="0"_STARTTIM
|
|---|
| 291 | FOR Q:$L(STARTTIM)>3 SET STARTTIM=STARTTIM_"0" ;"PAD OUT TIME TO 4 DIGITS
|
|---|
| 292 | FOR Q:$L(APTTIME)>3 SET APTTIME=APTTIME_"0" ;"PAD OUT TIME TO 4 DIGITS
|
|---|
| 293 | ;"SET DIFF=APTTIME-STARTTIM
|
|---|
| 294 | SET DIFF=$$MILDELTA^TMGSDAU1(STARTTIM,APTTIME)
|
|---|
| 295 | ;"SET SL=$P(^SC(SC,"SL"),"^",1)
|
|---|
| 296 | SET COUNT=DIFF/SL
|
|---|
| 297 | SET POS=9+(2*COUNT)
|
|---|
| 298 | ;"IF $E(VAL,POS,POS)'=" " Q 1
|
|---|
| 299 | NEW CH SET CH=$E(VAL,POS,POS)
|
|---|
| 300 | NEW NUMAVAIL SET NUMAVAIL=$FIND(CODES,CH)-$FIND(CODES,"0")
|
|---|
| 301 | IF NUMAVAIL>0 QUIT 1
|
|---|
| 302 | QUIT 0
|
|---|
| 303 | ;
|
|---|
| 304 | E2IDATE(TMGDATE)
|
|---|
| 305 | ;"Purpose: To return a FM-format Date from TMGDATE, converting if needed.
|
|---|
| 306 | ;"Input: TMGDATE: A date in external format, or FM-Date format
|
|---|
| 307 | ;" Note: if date is invalid, then "" is returned.
|
|---|
| 308 | NEW TMGRESULT SET TMGRESULT=$GET(TMGDATE)
|
|---|
| 309 | IF (TMGRESULT'=""),(+TMGRESULT'=TMGRESULT) DO
|
|---|
| 310 | . NEW MSG
|
|---|
| 311 | . DO DT^DILF("T",TMGDATE,.MSG)
|
|---|
| 312 | . SET TMGRESULT=MSG
|
|---|
| 313 | QUIT TMGRESULT
|
|---|
| 314 | ; |
|---|
