source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDNEXT.m@ 812

Last change on this file since 812 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1SDNEXT ;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
51 S SDNEXT="",SDCT=0 G RD^SDMULT
6DT 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
7LIM 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 ;
12NEW ;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
37EXIT ;
38 K VAUTD,VAUTNA,VAUTT,VAUTC,FIRST,SECOND,RANG,APPTL,SCPCMM,SDNEXT,SDCT
39 K VAUTCA,SCUP
40 Q
41 ;
42LENGTH() ;
43 ;prompt for appointment length
44 N LEN
45ST 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
50EX K DIR,Y,X
51 Q LEN
52 ;
53GETCLN(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 ;
66ADDCL(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 ;
82DRIVE(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
102CLEAN ;
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 ;
108ONE(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 ;
116CONMA(CIEN,CONT) ;continue to view, exit or make appointment
117 ;
118PRT ;
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"
127EX2 Q X
Note: See TracBrowser for help on using the repository browser.