| 1 | SDVWMKPI ;ENHANCED MAKE AN APPOINTMENT SDAPI 11/18/06 ;2/22/07 17:08
|
|---|
| 2 | ;;5.3;Scheduling;**502**;Aug 13, 1993 ;Build 14
|
|---|
| 3 | ; Copyright (C) 2007 WorldVistA
|
|---|
| 4 | ; GNU General Public License
|
|---|
| 5 | ;
|
|---|
| 6 | EN(DFN,SD1,SC,STYP,SDARRAY) ;
|
|---|
| 7 | ; MAKE AN APPOINTMENT
|
|---|
| 8 | ; INPUT
|
|---|
| 9 | ; DFN PATIENT(REQUIRED)
|
|---|
| 10 | ; SD1 APPOINTMENT DATE (REQUIRED)
|
|---|
| 11 | ; SC CLINIC FOR APPOINTMENT (REQUIRED)
|
|---|
| 12 | ; STYP (REQUIRED)
|
|---|
| 13 | ; =1 C&P
|
|---|
| 14 | ; =2 10-10
|
|---|
| 15 | ; =3 SCHEDULED APPOINTMENT
|
|---|
| 16 | ; =4 UNSCHEDULED VISIT
|
|---|
| 17 | ;
|
|---|
| 18 | ; SDARRAY("DATE NOW") (REQ AT TIME REQUEST MADE)
|
|---|
| 19 | ;
|
|---|
| 20 | ; SDARRAY("LAB DATE TIME ASSOCIATED") =
|
|---|
| 21 | ; "" OR DATE/TIME (OPTIONAL)
|
|---|
| 22 | ;
|
|---|
| 23 | ; SDARRAY("X-RAY DATE TIME ASSOCIATED") =
|
|---|
| 24 | ; "" OR DATE/TIME (OPTIONAL)
|
|---|
| 25 | ;
|
|---|
| 26 | ; SDARRAY("EKG DATE TIME ASSOCIATED") =
|
|---|
| 27 | ; "" OR DATE/TIME (OPTIONAL)
|
|---|
| 28 | ;
|
|---|
| 29 | ; SDARRAY("APPT TYPE") = 9 (REQUIRED)
|
|---|
| 30 | ; 9 for REGULAR APPOINTMENT TYPE
|
|---|
| 31 | ; ptr 409.1
|
|---|
| 32 | ; SDARRAY("APPT SUB-CATEGORY") = "0" (NOT USED)
|
|---|
| 33 | ; "0" for none
|
|---|
| 34 | ; ptr 35.2
|
|---|
| 35 | ;
|
|---|
| 36 | ; SDARRAY("SCHED_REQ_TYPE")='O' (REQUIRED)
|
|---|
| 37 | ; 'O' FOR OTHER THAN 'NEXT AVA.' APPT.;
|
|---|
| 38 | ; set of codes
|
|---|
| 39 | ; SDARRAY("NEXT APPT IND")=0 (REQUIRED)
|
|---|
| 40 | ; 0 FOR NO
|
|---|
| 41 | ; SDARRAY("DESIRED DATE TIME OF APPT")=SD (OPTIONAL)
|
|---|
| 42 | ; SDARRAY("FOLLOWUP VISIT INDICATOR")= (REQUIRED)
|
|---|
| 43 | ; "0" FOR NO
|
|---|
| 44 | ; "1" FOR YES
|
|---|
| 45 | ;
|
|---|
| 46 | ;
|
|---|
| 47 | ;
|
|---|
| 48 | ; SDARRAY("X RAY DATA FREE TEXT")= (OPTIONAL)
|
|---|
| 49 | ; SDARRAY("OTHER DATA FREE TEXT")= (OPTIONAL)
|
|---|
| 50 | ; SDARRAY("OTHER WARD LOCATION")= (OPTIONAL)
|
|---|
| 51 | ;
|
|---|
| 52 | ;
|
|---|
| 53 | ; SDARRAY("DATA ENTRY CLERK")= (REQUIRED)
|
|---|
| 54 | ; DUZ OR NEW PERSON (FILE 200) PTR
|
|---|
| 55 | ;
|
|---|
| 56 | ; SDARRAY("PRIOR XRAY RESULTS TO CLINIC")= (OPTIONAL)
|
|---|
| 57 | ; "Y" OR ""
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | ; SDARRAY("CHECKED-IN DATE")= (OPTIONAL)
|
|---|
| 61 | ; "" OR DATE APPOINTMENT MADE
|
|---|
| 62 | ; FOR AN UNSCHEDULED VISIT
|
|---|
| 63 | ;
|
|---|
| 64 | ; XQORMUTE ; EXIST AS NON-INTERACTIVE SILENT NODE W/O WRITE FOR XQOR ROUTINES
|
|---|
| 65 | ; SDVWNVAI ; EXIST AS NON-VA RELATED PFSS EVENT MODE
|
|---|
| 66 | ; = "D" DISABLING THE NEED FOR ICN
|
|---|
| 67 | ; = "O" AS OTHER NON-VA ICN SYSTEM ( FUTURE)
|
|---|
| 68 | ;
|
|---|
| 69 | ; Q 1 OK,APPOINTMENT SUCCESSFULLY MADE
|
|---|
| 70 | ; Q NEG NUMBER ERROR
|
|---|
| 71 | ; -101 INVALID PATIENT DFN
|
|---|
| 72 | ; -102 INVALID HOSPITAL LOCATION IEN (SC)
|
|---|
| 73 | ; -103 SD1 < DATE NOW
|
|---|
| 74 | ; -104 INVALID STYP
|
|---|
| 75 | ; -105 I $G(SDARRAY("DATE NOW"))=""
|
|---|
| 76 | ; -106 I $G(SDARRAY("APPT TYPE"))=""
|
|---|
| 77 | ; -107 I $G(SDARRAY("SCHED_REQ_TYPE"))=""
|
|---|
| 78 | ; -108 I $G(SDARRAY("NEXT APPT IND"))=""
|
|---|
| 79 | ; -109 I $G(SDARRAY("DATA ENTRY CLERK"))=""
|
|---|
| 80 | ; -110 I $G(SDARRAY("FOLLOWUP VISIT INDICATOR")=""
|
|---|
| 81 | ; -111 NO SCHEDULED SLOT WHERE SCHED APPT IS WANTED
|
|---|
| 82 | N SD,TIMEDD
|
|---|
| 83 | N SDCL,SDT,SDDA,SDMODE,SDORG
|
|---|
| 84 | N AJJ3CNT,SDY,SDATE,DAYW,AJJ3ONE,AJJ3OVER,AJJ3VAL,MULTM,START,INCRM
|
|---|
| 85 | N TIMED,ILENT,AJJ3MATC,AJJ3OV2,AJJ3VAL2,TIMED
|
|---|
| 86 | N SDSL,SL,SDSDATE,STARTDAY,D,SDHDL,SDEMP,SDMKHDL,SDMADE,SDLOCK,SDAPTYP,SDCOL
|
|---|
| 87 | ;
|
|---|
| 88 | N PURVISIT,SAVENOW,OVERBOOK,ELIGIB,OVERBOKM,AJJ3SAVE
|
|---|
| 89 | ;
|
|---|
| 90 | ;VALIDATE DFN, SC AS VALID PATIENTS AND CLINIC
|
|---|
| 91 | I '$D(^DPT(DFN,0)) Q -101
|
|---|
| 92 | I '$D(^SC(SC,0)) Q -102
|
|---|
| 93 | ;
|
|---|
| 94 | ;
|
|---|
| 95 | ;CHECK DATE>=NOW
|
|---|
| 96 | ;
|
|---|
| 97 | S SD=SD1
|
|---|
| 98 | S X=$G(SDARRAY("DATE NOW")) S SAVENOW=X
|
|---|
| 99 | I SD<SAVENOW Q -103
|
|---|
| 100 | I STYP=4 S SD=X
|
|---|
| 101 | ;FORMAT SD BELOW SHOULD BE FOUND IN NODE BELOW
|
|---|
| 102 | I $G(^SC(SC,"S",SD,0))=SD D
|
|---|
| 103 | .S AJJ3CNT=0
|
|---|
| 104 | .;.F S AJJ3CNT=$O(^SC(SC,"S",DT,1,AJJ3CNT)) Q:AJJ3CNT="" D
|
|---|
| 105 | .F S AJJ3CNT=$O(^SC(SC,"S",SD,1,AJJ3CNT)) Q:AJJ3CNT="" D
|
|---|
| 106 | ..S SDY=AJJ3CNT+1
|
|---|
| 107 | E D
|
|---|
| 108 | .;AJJ3CNT=SDY=1
|
|---|
| 109 | .S SDY=1
|
|---|
| 110 | I (STYP<1)!(STYP>4) Q -104
|
|---|
| 111 | ;
|
|---|
| 112 | ;CHECK OTHER REQUIRED VARIABLES
|
|---|
| 113 | I $G(SDARRAY("DATE NOW"))="" Q -105
|
|---|
| 114 | I $G(SDARRAY("APPT TYPE"))="" Q -106
|
|---|
| 115 | I $G(SDARRAY("SCHED_REQ_TYPE"))="" Q -107
|
|---|
| 116 | I $G(SDARRAY("NEXT APPT IND"))="" Q -108
|
|---|
| 117 | I $G(SDARRAY("DATA ENTRY CLERK"))="" Q -109
|
|---|
| 118 | I $G(SDARRAY("FOLLOWUP VISIT INDICATOR"))="" Q -110
|
|---|
| 119 | ;
|
|---|
| 120 | ;
|
|---|
| 121 | ;
|
|---|
| 122 | S AJJ3OV2=0
|
|---|
| 123 | I STYP'=4 D
|
|---|
| 124 | .;BEFORE MAKE APPT
|
|---|
| 125 | .;THIS MAY ALSO DO CHECKIN AN APPOINTMENT
|
|---|
| 126 | .;ALSO NEED TO CHECK AGAINST SCHEDULE FOR THAT DAY
|
|---|
| 127 | .;DETERMINE LAST RELATIVE ENTRY # FOR
|
|---|
| 128 | .;THIS APPOINTMENT DATE ( IF ANY) ON THIS CLINIC
|
|---|
| 129 | .;
|
|---|
| 130 | .;TO SEE IF OVERBOOK MAX ACHIEVED OR APPOINTMENT NOT AVAILABLE
|
|---|
| 131 | .;FOR THAT TIME AND DATE.
|
|---|
| 132 | .;GET DATE
|
|---|
| 133 | .S SDATE=SD\1
|
|---|
| 134 | .S TIMED=$P(SD,".",2)
|
|---|
| 135 | .S ILENT=$L(TIMED)
|
|---|
| 136 | .F Q:ILENT=4 D
|
|---|
| 137 | ..S TIMED=TIMED_"0" S ILENT=$L(TIMED) ;PAD OUT TIME TO 4 DIGITS
|
|---|
| 138 | .;W !,"TIMED=",TIMED
|
|---|
| 139 | .;CHECK WHAT MULTIPLE OF DAY OF WEEK FOR APPOINTMENT START
|
|---|
| 140 | .;GET DAY OF WEEK
|
|---|
| 141 | .S X=SDATE
|
|---|
| 142 | .D DW^%DTC
|
|---|
| 143 | .I X'="" D
|
|---|
| 144 | ..S DAYW=$E(X,1,2)
|
|---|
| 145 | ..;W !,"DAYW=",X
|
|---|
| 146 | ..S AJJ3ONE=0
|
|---|
| 147 | ..S AJJ3OVER=0
|
|---|
| 148 | ..;FIND DAY OF WEEK ENTRY IN "ST" MULT , THEN FIND STARTING TIME AND
|
|---|
| 149 | ..;TIME MATCH IN SAME "T" MULT.
|
|---|
| 150 | ..S AJJ3MATC=0
|
|---|
| 151 | ..F S AJJ3ONE=$O(^SC(SC,"ST",AJJ3ONE)) Q:(AJJ3ONE="")!(AJJ3OVER'=0) D
|
|---|
| 152 | ...S AJJ3VAL=$G(^SC(SC,"ST",AJJ3ONE,1)) S X2=AJJ3ONE S X1=SDATE D ^%DTC S SDIFF=X I ($E(AJJ3VAL,1,2)=DAYW)&(SDIFF'<0) S AJJ3SAVE=AJJ3ONE I $$CHKAVAIL(AJJ3SAVE,SD) S AJJ3OVER=AJJ3ONE
|
|---|
| 153 | ...;W !,"AJJ3VAL=",AJJ3VAL," AJJ3ONE=",AJJ3ONE," SDATE=",SDATE," SDIFF=",SDIFF
|
|---|
| 154 | ...I AJJ3OVER'=0 D
|
|---|
| 155 | ....S AJJ3INCR=0
|
|---|
| 156 | ....F S AJJ3INCR=$O(^SC(SC,"T",AJJ3OVER,2,AJJ3INCR)) Q:(AJJ3INCR="")!(AJJ3OV2=1) D
|
|---|
| 157 | .....S AJJ3VAL2=$G(^SC(SC,"T",AJJ3OVER,2,AJJ3INCR,0)) S AJJ3VAL2=$P(AJJ3VAL2,"^",1) I AJJ3VAL2=TIMED S AJJ3OV2=1
|
|---|
| 158 | ..I AJJ3OV2'=0 D
|
|---|
| 159 | ...;NOW CHECK IN "S" ARRAY TO SEE IF APPT ALREADY MADE
|
|---|
| 160 | ...I SDY'=1 D
|
|---|
| 161 | ....;CHECK IF OVERBOOKS ALLOWED
|
|---|
| 162 | ....I $P($G(^SC(SC,"SL")),"^",7)=0 S AJJ3OV2=0
|
|---|
| 163 | .E D
|
|---|
| 164 | ..S AJJ3OV2=0
|
|---|
| 165 | E D
|
|---|
| 166 | .;ALSO
|
|---|
| 167 | .S AJJ3OV2=1
|
|---|
| 168 | I AJJ3OV2'=0 D
|
|---|
| 169 | .;
|
|---|
| 170 | .;D NOW^%DTC S X2=X\1 S SAVENOW=X S X1=SDATE D ^%DTC IF X<0 S AJJ3OV2=0
|
|---|
| 171 | .D
|
|---|
| 172 | ..S SDCL=SC
|
|---|
| 173 | ..S SDT=SD
|
|---|
| 174 | ..S SDDA=SDY
|
|---|
| 175 | ..S SDMODE=2
|
|---|
| 176 | ..S SDORG=1
|
|---|
| 177 | ..;ADDITIONAL
|
|---|
| 178 | ..;S SDSL=$P(^SC(SC,"SL"),"^",1) S SL=SDSL S SDXSCAT=0
|
|---|
| 179 | ..S SL=$P(^SC(SC,"SL"),"^",1)
|
|---|
| 180 | ..S SDSDATE=SD
|
|---|
| 181 | ..;S STARTDAY
|
|---|
| 182 | ..;
|
|---|
| 183 | ..;START PREPARING DATA FROM SDARRAY INTO NODES
|
|---|
| 184 | ..;
|
|---|
| 185 | ..;FIRST INITIAL TOP NODE FOR APPOINTMENT SUB-FILE
|
|---|
| 186 | ..S ^DPT(DFN,"S",0)="^2.98P^^"
|
|---|
| 187 | ..L +^DPT(DFN,"S",0):5
|
|---|
| 188 | ..;NEXT NODE 0
|
|---|
| 189 | ..S PURVISIT=STYP
|
|---|
| 190 | ..S TIMEDD=$P(SD,".",1)
|
|---|
| 191 | ..S ^DPT(DFN,"S",SD,0)=SC_"^^"_$G(SDARRAY("LAB DATE TIME ASSOCIATED"))_"^"_$G(SDARRAY("X-RAY DATE TIME ASSOCIATED"))_"^"_$G(SDARRAY("EKG DATE TIME ASSOCIATED"))
|
|---|
| 192 | ..S ^DPT(DFN,"S",SD,0)=^DPT(DFN,"S",SD,0)_"^^"_PURVISIT_"^^^^^^^^^"_$G(SDARRAY("APPT TYPE"))_"^^^"_TIMEDD_"^^^^^"_0
|
|---|
| 193 | ..S ^DPT(DFN,"S",SD,0)=^DPT(DFN,"S",SD,0)_"^"_$G(SDARRAY("SCHED_REQ_TYPE"))_"^"_$G(SDARRAY("NEXT APPT IND"))
|
|---|
| 194 | ..;NEXT NODE 1
|
|---|
| 195 | ..I $G(SDARRAY("DESIRED DATE TIME OF APPT"))'="" D
|
|---|
| 196 | ...S ^DPT(DFN,"S",SD,1)=$G(SDARRAY("DESIRED DATE TIME OF APPT"))_"^"_$G(SDARRAY("FOLLOWUP VISIT INDICATOR"))
|
|---|
| 197 | ..E D
|
|---|
| 198 | ...;
|
|---|
| 199 | ...S ^DPT(DFN,"S",SD,1)=TIMEDD_"^"_$G(SDARRAY("FOLLOWUP VISIT INDICATOR"))
|
|---|
| 200 | ..L -^DPT(DFN,"S",0)
|
|---|
| 201 | ..;NOW FILE 44 MULTIPLE IN APPOINTMENT SUB-FILE
|
|---|
| 202 | ..;FIRST TOP NODE IN CLINIC FOR DATE
|
|---|
| 203 | ..S ^SC(SC,"S",0)="^44.001DA^^"
|
|---|
| 204 | ..L +^SC(SC,"S",0):5
|
|---|
| 205 | ..;NEXT DATE MULTIPLE
|
|---|
| 206 | ..S ^SC(SC,"S",SD,0)=SD
|
|---|
| 207 | ..;NEXT TOP NODE UNDER DATE FOR PATIENT
|
|---|
| 208 | ..S ^SC(SC,"S",SD,1,0)="^44.003PA^^"
|
|---|
| 209 | ..;NEXT MULTIPLE ENTRY PER PATIENT
|
|---|
| 210 | ..S ^SC(SC,"S",SD,1,SDY,0)=DFN_"^"_SL_"^"_$G(SDARRAY("X RAY DATA FREE TEXT"))_"^"_$G(SDARRAY("OTHER DATA FREE TEXT"))_"^"_$G(SDARRAY("OTHER WARD LOCATION"))
|
|---|
| 211 | ..S ^SC(SC,"S",SD,1,SDY,0)=^SC(SC,"S",SD,1,SDY,0)_"^"_$G(SDARRAY("DATA ENTRY CLERK"))_"^"_SAVENOW
|
|---|
| 212 | ..I STYP=4 S ^SC(SC,"S",SD,1,SDY,0)=^SC(SC,"S",SD,1,SDY,0)_"^"_$G(SDARRAY("PRIOR X-RAY RESULTS TO CLINIC"))
|
|---|
| 213 | ..;DETERMINE ANY OVERBOOK AND ELIGIBILITY HERE
|
|---|
| 214 | ..;
|
|---|
| 215 | ..S OVERBOKM=$P(^SC(SC,"SL"),"^",7)
|
|---|
| 216 | ..I SDY>OVERBOKM D
|
|---|
| 217 | ...S OVERBOOK="O"
|
|---|
| 218 | ...S ^SC(SC,"S",SD,1,SDY,"OB")="0"
|
|---|
| 219 | ..E D
|
|---|
| 220 | ...S OVERBOOK=""
|
|---|
| 221 | ..;ELIGIBILITY NEXT
|
|---|
| 222 | ..D ELIG^VADPT S ELIGIB=$P(VAEL(1),"^",1)
|
|---|
| 223 | ..IF STYP=4 S ^SC(SC,"S",SD,1,SDY,0)=^SC(SC,"S",SD,1,SDY,0)_"^"_"^"_"^"_ELIGIB
|
|---|
| 224 | ..;NOW UNSCHEDULED VISITS EXTRA DATA
|
|---|
| 225 | ..;REALLY LATER MAY NEED ELIGIBILITY FOR NON-VA SYSTEMS PATIENTS WITH
|
|---|
| 226 | ..;SCHEDULED APPTS AND UNSCHEDULED VISITS ( HUMANITARIAN, REIMBURSABLE INSURANCE, ETC)
|
|---|
| 227 | ..I STYP=4 D
|
|---|
| 228 | ...S ^SC(SC,"S",SD,1,SDY,"C")=SD_"^"_$G(SDARRAY("DATA ENTRY CLERK"))_"^^^"_SD
|
|---|
| 229 | ..L -^SC(SC,"S",0)
|
|---|
| 230 | ..;EVENT GENERATION ALSO FOR PFSS SYSTEM WHICH CAN BE USED WITH AN EXTERNAL SCHEDULING SYSTEM
|
|---|
| 231 | ..;FOR MAKE APPT EVENTS AS WELL AS CHECKIN,CHECKOUT,CANCEL,DELETE, AND OUTPATIENT ENCOUNTER DATA
|
|---|
| 232 | ..D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
|
|---|
| 233 | E Q -111
|
|---|
| 234 | Q 1
|
|---|
| 235 | CHKAVAIL(AJJ3SAVE,SD) ;
|
|---|
| 236 | N SL,AJJ3VAL,DATE,STARTTIM,TIMED,ILENT,SL,POS,COUNT
|
|---|
| 237 | ;CHECK IF SLOT ALLOWED FOR THAT DAY/TIME SLOT
|
|---|
| 238 | S SL=$P($G(^SC(SC,"SL")),"^",1) ;LENGTH OF APPT
|
|---|
| 239 | S AJJ3VAL=$G(^SC(SC,"ST",AJJ3SAVE,1))
|
|---|
| 240 | ;START AT 9TH PIECE TO SEE IF NON-BLANK
|
|---|
| 241 | ;FORMAT DATE+STARTTIME
|
|---|
| 242 | S STARTTIM=$P($G(^SC(SC,"SL")),"^",3) ;STARTIM
|
|---|
| 243 | I $L(STARTTIM)=1 S STARTTIM="0"_STARTTIM
|
|---|
| 244 | ;0 PAD TO 4 DIGITS STARTTIM
|
|---|
| 245 | S ILENT=$L(STARTTIM)
|
|---|
| 246 | F Q:ILENT=4 D
|
|---|
| 247 | .S STARTTIM=STARTTIM_"0" S ILENT=$L(STARTTIM) ;PAD OUT TIME TO 4 DIGITS
|
|---|
| 248 | S TIMED=$P(SD,".",2)
|
|---|
| 249 | S ILENT=$L(TIMED)
|
|---|
| 250 | F Q:ILENT=4 D
|
|---|
| 251 | .S TIMED=TIMED_"0" S ILENT=$L(TIMED) ;PAD OUT TIME TO 4 DIGITS
|
|---|
| 252 | S DIFF=TIMED-STARTTIM
|
|---|
| 253 | S SL=$P(^SC(SC,"SL"),"^",1)
|
|---|
| 254 | S COUNT=DIFF/SL
|
|---|
| 255 | S POS=9+2*COUNT
|
|---|
| 256 | I $E(AJJ3VAL,POS,POS)'=" " Q 1
|
|---|
| 257 | Q 0
|
|---|
