| 1 | SDNEXT ;ALB/TMP - FIND NEXT AVAILABLE APPOINTMENT FOR A CLINIC ; 18 APR 86
|
|---|
| 2 | ;;5.3;Scheduling;**41,45,165**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
|
|---|
| 5 | 1 S SDNEXT="",SDCT=0 G RD^SDMULT
|
|---|
| 6 | DT S FND=0,%DT(0)=-SDMAX,%DT="AEF",%DT("A")=" START SEARCH FOR NEXT AVAILABLE FROM WHAT DATE: " D ^%DT K %DT G:"^"[X 1:$S('$D(SDNEXT):1,'SDNEXT:1,1:0),END^SDMULT0 G:Y<0 DT S SDSTRTDT=+Y
|
|---|
| 7 | LIM W !," ENTER LATEST DATE TO CHECK FOR 1ST AVAILABLE SLOT: " S Y=SDMAX D DT^DIQ R "// ",X:DTIME G:X["^"!'($T) END^SDMULT0 I X']"" G OVR^SDMULT0
|
|---|
| 8 | I X?.E1"?" W !," The latest date for future bookings for ",$P(SDC(1),"^",2)," is: " S Y=SDMAX D DTS^SDUTL W Y,!," If you enter a date here, it must be less than this date to further limit the",!," search" G LIM
|
|---|
| 9 | S %DT="EF",%DT(0)=-SDMAX D ^%DT K %DT G:Y<0!(Y<SDSTRTDT) LIM S:Y>0 SDMAX=+Y
|
|---|
| 10 | G OVR^SDMULT0
|
|---|
| 11 | ;
|
|---|
| 12 | NEW ;entry point to be use for next available appt. 3/29/96
|
|---|
| 13 | K VAUTT,VAUTC,SCUP
|
|---|
| 14 | N SCOKNULL
|
|---|
| 15 | S SCOKNULL=1
|
|---|
| 16 | S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
|
|---|
| 17 | S SDNEXT="",SDCT=0
|
|---|
| 18 | S VAUTNA="" ;don't allow all to be selected
|
|---|
| 19 | S VAUTCA="" ;allow any clinic to be selected
|
|---|
| 20 | S VAUTD=1 ;all divisions
|
|---|
| 21 | D CLINIC^SCRPU1 ;prompt for clinics (none,one,many)
|
|---|
| 22 | Q:$D(SCUP) ; "^" SELECTED
|
|---|
| 23 | D PRMTT^SCRPU1 ;prompt for team (none,one,many)
|
|---|
| 24 | Q:('$D(VAUTT))&('$D(VAUTC))
|
|---|
| 25 | Q:$D(SCUP) ; "^" SELECTED
|
|---|
| 26 | S APPTL=$$LENGTH()
|
|---|
| 27 | Q:APPTL<0
|
|---|
| 28 | S FIRST="First date to check for 1st available appointments: "
|
|---|
| 29 | S SECOND="Latest date to check for available appointments: "
|
|---|
| 30 | S RANG=$$DTRANG^SCRPU2(FIRST,SECOND)
|
|---|
| 31 | I RANG=-1 D CLEAN,EXIT Q
|
|---|
| 32 | I $D(VAUTT) D GETCLN(.VAUTT,.VAUTC)
|
|---|
| 33 | ;all clinics selected & position assoc clinics in VAUTC(ien)=clinic name
|
|---|
| 34 | D DRIVE(.VAUTC,APPTL,RANG)
|
|---|
| 35 | D CLEAN,EXIT
|
|---|
| 36 | Q
|
|---|
| 37 | EXIT ;
|
|---|
| 38 | K VAUTD,VAUTNA,VAUTT,VAUTC,FIRST,SECOND,RANG,APPTL,SCPCMM,SDNEXT,SDCT
|
|---|
| 39 | K VAUTCA,SCUP
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | LENGTH() ;
|
|---|
| 43 | ;prompt for appointment length
|
|---|
| 44 | N LEN
|
|---|
| 45 | ST S DIR(0)="N"
|
|---|
| 46 | S DIR("A")="Appointment Length Needed "
|
|---|
| 47 | D ^DIR
|
|---|
| 48 | I Y=""!(X="^")!(X="") S LEN=-1 G EX
|
|---|
| 49 | S LEN=X
|
|---|
| 50 | EX K DIR,Y,X
|
|---|
| 51 | Q LEN
|
|---|
| 52 | ;
|
|---|
| 53 | GETCLN(TEAM,CLINIC) ;add assoc. clinics for teams to clinic array
|
|---|
| 54 | ;TEAM - team array
|
|---|
| 55 | ;CLINIC - clinic array
|
|---|
| 56 | ;
|
|---|
| 57 | N TM,LIST,ERR,OKAY
|
|---|
| 58 | S TM=0,LIST="TPLIST",ERR="ERR1"
|
|---|
| 59 | F S TM=$O(TEAM(TM)) Q:TM=""!(TM'?.N) D
|
|---|
| 60 | .K @LIST,@ERR
|
|---|
| 61 | .S OKAY=$$TPTM^SCAPMC24(TM,"","","",LIST,ERR)
|
|---|
| 62 | .;@LIST contains all positions for team TM
|
|---|
| 63 | .I $G(@LIST@(0))>0 D ADDCL(.CLINIC,LIST)
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | ADDCL(CLINIC,PTLIST) ;add team's associated clinics to clinic list
|
|---|
| 67 | ;CLINIC - array of selected clinics
|
|---|
| 68 | ;PTLIST - array of all positions for a selected team
|
|---|
| 69 | N CNAME,CIEN,TPNODE,TPIEN,NODE,EN
|
|---|
| 70 | S EN=0
|
|---|
| 71 | F S EN=$O(@PTLIST@(EN)) Q:EN=""!(EN'?.N) D
|
|---|
| 72 | .S NODE=$G(@PTLIST@(EN))
|
|---|
| 73 | .S TPIEN=+$P(NODE,"^") ;team position ien
|
|---|
| 74 | .S TPNODE=$G(^SCTM(404.57,TPIEN,0))
|
|---|
| 75 | .Q:TPNODE=""
|
|---|
| 76 | .S CIEN=+$P(TPNODE,"^",9) ;clinic ien
|
|---|
| 77 | .Q:CIEN=0 ;no associated clinic
|
|---|
| 78 | .S CNAME=$P($G(^SC(CIEN,0)),"^") ;clinic name
|
|---|
| 79 | .S CLINIC(CIEN)=CNAME
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | DRIVE(CLINICA,LEN,BEGEND) ;driver
|
|---|
| 83 | ;CLINICA - clinic array
|
|---|
| 84 | ;LEN - appt. length wanted
|
|---|
| 85 | ;BEGEND - begin date ^ end date
|
|---|
| 86 | ;
|
|---|
| 87 | N CIEN,COUNT,CONT,FND
|
|---|
| 88 | S SDNEXT="",SDCT=1
|
|---|
| 89 | S CIEN=0,STOP=0,COUNT=1
|
|---|
| 90 | F S CIEN=$O(CLINICA(CIEN)) Q:CIEN=""!(CIEN'?.N)!(STOP) D
|
|---|
| 91 | .S SDNEXT=""
|
|---|
| 92 | .S SDSTRTDT=$P(BEGEND,"^")
|
|---|
| 93 | .S SDMAX=$P(BEGEND,"^",2)
|
|---|
| 94 | .S SDC(COUNT)=CIEN,SDC1(CIEN)=$G(CLINICA(CIEN))_"^"_LEN
|
|---|
| 95 | .S SDCT=COUNT,SC=CIEN,FND=0
|
|---|
| 96 | .D OVR^SDMULT0 S CONT=$$CONMA(CIEN,$S($O(CLINICA(CIEN)):0,1:1))
|
|---|
| 97 | .K SDC(COUNT),SDC1(CIEN)
|
|---|
| 98 | .;S CONT=$$CONMA(CIEN)
|
|---|
| 99 | .Q:STOP
|
|---|
| 100 | I $G(CONT)="M" D CLEAN S:$$ONE(.CLINICA) SDCLN=$O(CLINICA(0)) G ^SDM
|
|---|
| 101 | Q
|
|---|
| 102 | CLEAN ;
|
|---|
| 103 | D END^SDMULT0
|
|---|
| 104 | K SDSTRTDT,SDNEXT,SDMAX,SDC,SDCT,SDC1,SDL,STOP,SDAPP,SDPCMM,SDCLN,FND
|
|---|
| 105 | K SCPCC,SDPCM1,SC
|
|---|
| 106 | Q
|
|---|
| 107 | ;
|
|---|
| 108 | ONE(CLNA) ;one clinic selected? 1 or 0
|
|---|
| 109 | N CNT,FIRST,RET,STP
|
|---|
| 110 | S (CNT,STP)=0,RET=1
|
|---|
| 111 | F S CNT=$O(CLNA(CNT)) Q:CNT=""!(STP) D
|
|---|
| 112 | .I $D(FIRST) S STOP=1,RET=0
|
|---|
| 113 | .I '$D(FIRST) S FIRST=1
|
|---|
| 114 | Q RET
|
|---|
| 115 | ;
|
|---|
| 116 | CONMA(CIEN,CONT) ;continue to view, exit or make appointment
|
|---|
| 117 | ;
|
|---|
| 118 | PRT ;
|
|---|
| 119 | S CONT=$G(CONT)
|
|---|
| 120 | I $G(SDPCMM(CIEN))'>0&('CONT) Q -1
|
|---|
| 121 | W !,"'^' TO EXIT"_$S('CONT:", 'C' TO CONTINUE",1:"")_" OR 'M' TO GOTO MAKE APPOINTMENT: "_$S(CONT:"^",1:"CONTINUE")_"//" R X:DTIME
|
|---|
| 122 | I '$T!(X="^") S STOP=1,X=-1 G EX2
|
|---|
| 123 | I (X'="^")&(X'="C")&(X'="M")&(X'="") G PRT
|
|---|
| 124 | I CONT&(X="C") G PRT
|
|---|
| 125 | I X="M" S STOP=1
|
|---|
| 126 | I X="" S X="C"
|
|---|
| 127 | EX2 Q X
|
|---|
