SDVWMKPI ;ENHANCED MAKE AN APPOINTMENT SDAPI 11/18/06 ;2/22/07 17:08 ;;5.3;Scheduling;**502**;Aug 13, 1993 ;Build 14 ; Copyright (C) 2007 WorldVistA ; GNU General Public License ; EN(DFN,SD1,SC,STYP,SDARRAY) ; ; MAKE AN APPOINTMENT ; INPUT ; DFN PATIENT(REQUIRED) ; SD1 APPOINTMENT DATE (REQUIRED) ; SC CLINIC FOR APPOINTMENT (REQUIRED) ; STYP (REQUIRED) ; =1 C&P ; =2 10-10 ; =3 SCHEDULED APPOINTMENT ; =4 UNSCHEDULED VISIT ; ; SDARRAY("DATE NOW") (REQ AT TIME REQUEST MADE) ; ; SDARRAY("LAB DATE TIME ASSOCIATED") = ; "" OR DATE/TIME (OPTIONAL) ; ; SDARRAY("X-RAY DATE TIME ASSOCIATED") = ; "" OR DATE/TIME (OPTIONAL) ; ; SDARRAY("EKG DATE TIME ASSOCIATED") = ; "" OR DATE/TIME (OPTIONAL) ; ; SDARRAY("APPT TYPE") = 9 (REQUIRED) ; 9 for REGULAR APPOINTMENT TYPE ; ptr 409.1 ; SDARRAY("APPT SUB-CATEGORY") = "0" (NOT USED) ; "0" for none ; ptr 35.2 ; ; SDARRAY("SCHED_REQ_TYPE")='O' (REQUIRED) ; 'O' FOR OTHER THAN 'NEXT AVA.' APPT.; ; set of codes ; SDARRAY("NEXT APPT IND")=0 (REQUIRED) ; 0 FOR NO ; SDARRAY("DESIRED DATE TIME OF APPT")=SD (OPTIONAL) ; SDARRAY("FOLLOWUP VISIT INDICATOR")= (REQUIRED) ; "0" FOR NO ; "1" FOR YES ; ; ; ; SDARRAY("X RAY DATA FREE TEXT")= (OPTIONAL) ; SDARRAY("OTHER DATA FREE TEXT")= (OPTIONAL) ; SDARRAY("OTHER WARD LOCATION")= (OPTIONAL) ; ; ; SDARRAY("DATA ENTRY CLERK")= (REQUIRED) ; DUZ OR NEW PERSON (FILE 200) PTR ; ; SDARRAY("PRIOR XRAY RESULTS TO CLINIC")= (OPTIONAL) ; "Y" OR "" ; ; ; SDARRAY("CHECKED-IN DATE")= (OPTIONAL) ; "" OR DATE APPOINTMENT MADE ; FOR AN UNSCHEDULED VISIT ; ; XQORMUTE ; EXIST AS NON-INTERACTIVE SILENT NODE W/O WRITE FOR XQOR ROUTINES ; SDVWNVAI ; EXIST AS NON-VA RELATED PFSS EVENT MODE ; = "D" DISABLING THE NEED FOR ICN ; = "O" AS OTHER NON-VA ICN SYSTEM ( FUTURE) ; ; Q 1 OK,APPOINTMENT SUCCESSFULLY MADE ; Q NEG NUMBER ERROR ; -101 INVALID PATIENT DFN ; -102 INVALID HOSPITAL LOCATION IEN (SC) ; -103 SD1 < DATE NOW ; -104 INVALID STYP ; -105 I $G(SDARRAY("DATE NOW"))="" ; -106 I $G(SDARRAY("APPT TYPE"))="" ; -107 I $G(SDARRAY("SCHED_REQ_TYPE"))="" ; -108 I $G(SDARRAY("NEXT APPT IND"))="" ; -109 I $G(SDARRAY("DATA ENTRY CLERK"))="" ; -110 I $G(SDARRAY("FOLLOWUP VISIT INDICATOR")="" ; -111 NO SCHEDULED SLOT WHERE SCHED APPT IS WANTED N SD,TIMEDD N SDCL,SDT,SDDA,SDMODE,SDORG N AJJ3CNT,SDY,SDATE,DAYW,AJJ3ONE,AJJ3OVER,AJJ3VAL,MULTM,START,INCRM N TIMED,ILENT,AJJ3MATC,AJJ3OV2,AJJ3VAL2,TIMED N SDSL,SL,SDSDATE,STARTDAY,D,SDHDL,SDEMP,SDMKHDL,SDMADE,SDLOCK,SDAPTYP,SDCOL ; N PURVISIT,SAVENOW,OVERBOOK,ELIGIB,OVERBOKM,AJJ3SAVE ; ;VALIDATE DFN, SC AS VALID PATIENTS AND CLINIC I '$D(^DPT(DFN,0)) Q -101 I '$D(^SC(SC,0)) Q -102 ; ; ;CHECK DATE>=NOW ; S SD=SD1 S X=$G(SDARRAY("DATE NOW")) S SAVENOW=X I SD4) Q -104 ; ;CHECK OTHER REQUIRED VARIABLES I $G(SDARRAY("DATE NOW"))="" Q -105 I $G(SDARRAY("APPT TYPE"))="" Q -106 I $G(SDARRAY("SCHED_REQ_TYPE"))="" Q -107 I $G(SDARRAY("NEXT APPT IND"))="" Q -108 I $G(SDARRAY("DATA ENTRY CLERK"))="" Q -109 I $G(SDARRAY("FOLLOWUP VISIT INDICATOR"))="" Q -110 ; ; ; S AJJ3OV2=0 I STYP'=4 D .;BEFORE MAKE APPT .;THIS MAY ALSO DO CHECKIN AN APPOINTMENT .;ALSO NEED TO CHECK AGAINST SCHEDULE FOR THAT DAY .;DETERMINE LAST RELATIVE ENTRY # FOR .;THIS APPOINTMENT DATE ( IF ANY) ON THIS CLINIC .; .;TO SEE IF OVERBOOK MAX ACHIEVED OR APPOINTMENT NOT AVAILABLE .;FOR THAT TIME AND DATE. .;GET DATE .S SDATE=SD\1 .S TIMED=$P(SD,".",2) .S ILENT=$L(TIMED) .F Q:ILENT=4 D ..S TIMED=TIMED_"0" S ILENT=$L(TIMED) ;PAD OUT TIME TO 4 DIGITS .;W !,"TIMED=",TIMED .;CHECK WHAT MULTIPLE OF DAY OF WEEK FOR APPOINTMENT START .;GET DAY OF WEEK .S X=SDATE .D DW^%DTC .I X'="" D ..S DAYW=$E(X,1,2) ..;W !,"DAYW=",X ..S AJJ3ONE=0 ..S AJJ3OVER=0 ..;FIND DAY OF WEEK ENTRY IN "ST" MULT , THEN FIND STARTING TIME AND ..;TIME MATCH IN SAME "T" MULT. ..S AJJ3MATC=0 ..F S AJJ3ONE=$O(^SC(SC,"ST",AJJ3ONE)) Q:(AJJ3ONE="")!(AJJ3OVER'=0) D ...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 ...;W !,"AJJ3VAL=",AJJ3VAL," AJJ3ONE=",AJJ3ONE," SDATE=",SDATE," SDIFF=",SDIFF ...I AJJ3OVER'=0 D ....S AJJ3INCR=0 ....F S AJJ3INCR=$O(^SC(SC,"T",AJJ3OVER,2,AJJ3INCR)) Q:(AJJ3INCR="")!(AJJ3OV2=1) D .....S AJJ3VAL2=$G(^SC(SC,"T",AJJ3OVER,2,AJJ3INCR,0)) S AJJ3VAL2=$P(AJJ3VAL2,"^",1) I AJJ3VAL2=TIMED S AJJ3OV2=1 ..I AJJ3OV2'=0 D ...;NOW CHECK IN "S" ARRAY TO SEE IF APPT ALREADY MADE ...I SDY'=1 D ....;CHECK IF OVERBOOKS ALLOWED ....I $P($G(^SC(SC,"SL")),"^",7)=0 S AJJ3OV2=0 .E D ..S AJJ3OV2=0 E D .;ALSO .S AJJ3OV2=1 I AJJ3OV2'=0 D .; .;D NOW^%DTC S X2=X\1 S SAVENOW=X S X1=SDATE D ^%DTC IF X<0 S AJJ3OV2=0 .D ..S SDCL=SC ..S SDT=SD ..S SDDA=SDY ..S SDMODE=2 ..S SDORG=1 ..;ADDITIONAL ..;S SDSL=$P(^SC(SC,"SL"),"^",1) S SL=SDSL S SDXSCAT=0 ..S SL=$P(^SC(SC,"SL"),"^",1) ..S SDSDATE=SD ..;S STARTDAY ..; ..;START PREPARING DATA FROM SDARRAY INTO NODES ..; ..;FIRST INITIAL TOP NODE FOR APPOINTMENT SUB-FILE ..S ^DPT(DFN,"S",0)="^2.98P^^" ..L +^DPT(DFN,"S",0):5 ..;NEXT NODE 0 ..S PURVISIT=STYP ..S TIMEDD=$P(SD,".",1) ..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")) ..S ^DPT(DFN,"S",SD,0)=^DPT(DFN,"S",SD,0)_"^^"_PURVISIT_"^^^^^^^^^"_$G(SDARRAY("APPT TYPE"))_"^^^"_TIMEDD_"^^^^^"_0 ..S ^DPT(DFN,"S",SD,0)=^DPT(DFN,"S",SD,0)_"^"_$G(SDARRAY("SCHED_REQ_TYPE"))_"^"_$G(SDARRAY("NEXT APPT IND")) ..;NEXT NODE 1 ..I $G(SDARRAY("DESIRED DATE TIME OF APPT"))'="" D ...S ^DPT(DFN,"S",SD,1)=$G(SDARRAY("DESIRED DATE TIME OF APPT"))_"^"_$G(SDARRAY("FOLLOWUP VISIT INDICATOR")) ..E D ...; ...S ^DPT(DFN,"S",SD,1)=TIMEDD_"^"_$G(SDARRAY("FOLLOWUP VISIT INDICATOR")) ..L -^DPT(DFN,"S",0) ..;NOW FILE 44 MULTIPLE IN APPOINTMENT SUB-FILE ..;FIRST TOP NODE IN CLINIC FOR DATE ..S ^SC(SC,"S",0)="^44.001DA^^" ..L +^SC(SC,"S",0):5 ..;NEXT DATE MULTIPLE ..S ^SC(SC,"S",SD,0)=SD ..;NEXT TOP NODE UNDER DATE FOR PATIENT ..S ^SC(SC,"S",SD,1,0)="^44.003PA^^" ..;NEXT MULTIPLE ENTRY PER PATIENT ..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")) ..S ^SC(SC,"S",SD,1,SDY,0)=^SC(SC,"S",SD,1,SDY,0)_"^"_$G(SDARRAY("DATA ENTRY CLERK"))_"^"_SAVENOW ..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")) ..;DETERMINE ANY OVERBOOK AND ELIGIBILITY HERE ..; ..S OVERBOKM=$P(^SC(SC,"SL"),"^",7) ..I SDY>OVERBOKM D ...S OVERBOOK="O" ...S ^SC(SC,"S",SD,1,SDY,"OB")="0" ..E D ...S OVERBOOK="" ..;ELIGIBILITY NEXT ..D ELIG^VADPT S ELIGIB=$P(VAEL(1),"^",1) ..IF STYP=4 S ^SC(SC,"S",SD,1,SDY,0)=^SC(SC,"S",SD,1,SDY,0)_"^"_"^"_"^"_ELIGIB ..;NOW UNSCHEDULED VISITS EXTRA DATA ..;REALLY LATER MAY NEED ELIGIBILITY FOR NON-VA SYSTEMS PATIENTS WITH ..;SCHEDULED APPTS AND UNSCHEDULED VISITS ( HUMANITARIAN, REIMBURSABLE INSURANCE, ETC) ..I STYP=4 D ...S ^SC(SC,"S",SD,1,SDY,"C")=SD_"^"_$G(SDARRAY("DATA ENTRY CLERK"))_"^^^"_SD ..L -^SC(SC,"S",0) ..;EVENT GENERATION ALSO FOR PFSS SYSTEM WHICH CAN BE USED WITH AN EXTERNAL SCHEDULING SYSTEM ..;FOR MAKE APPT EVENTS AS WELL AS CHECKIN,CHECKOUT,CANCEL,DELETE, AND OUTPATIENT ENCOUNTER DATA ..D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) E Q -111 Q 1 CHKAVAIL(AJJ3SAVE,SD) ; N SL,AJJ3VAL,DATE,STARTTIM,TIMED,ILENT,SL,POS,COUNT ;CHECK IF SLOT ALLOWED FOR THAT DAY/TIME SLOT S SL=$P($G(^SC(SC,"SL")),"^",1) ;LENGTH OF APPT S AJJ3VAL=$G(^SC(SC,"ST",AJJ3SAVE,1)) ;START AT 9TH PIECE TO SEE IF NON-BLANK ;FORMAT DATE+STARTTIME S STARTTIM=$P($G(^SC(SC,"SL")),"^",3) ;STARTIM I $L(STARTTIM)=1 S STARTTIM="0"_STARTTIM ;0 PAD TO 4 DIGITS STARTTIM S ILENT=$L(STARTTIM) F Q:ILENT=4 D .S STARTTIM=STARTTIM_"0" S ILENT=$L(STARTTIM) ;PAD OUT TIME TO 4 DIGITS S TIMED=$P(SD,".",2) S ILENT=$L(TIMED) F Q:ILENT=4 D .S TIMED=TIMED_"0" S ILENT=$L(TIMED) ;PAD OUT TIME TO 4 DIGITS S DIFF=TIMED-STARTTIM S SL=$P(^SC(SC,"SL"),"^",1) S COUNT=DIFF/SL S POS=9+2*COUNT I $E(AJJ3VAL,POS,POS)'=" " Q 1 Q 0