Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDNEXT

SDNEXT.m

Go to the documentation of this file. 
  1. SDNEXT ;ALB/TMP - FIND NEXT AVAILABLE APPOINTMENT FOR A CLINIC ; 18 APR 86
  1.  ;;5.3;PIMS;**41,45,165,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
  1. 1 S SDNEXT="",SDCT=0 G RD^SDMULT
  1. 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
  1. 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
  1.  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
  1.  S %DT="EF",%DT(0)=-SDMAX D ^%DT K %DT G:Y<0!(Y<SDSTRTDT) LIM S:Y>0 SDMAX=+Y
  1.  G OVR^SDMULT0
  1.  ;
  1. NEW ;entry point to be use for next available appt. 3/29/96
  1.  K VAUTT,VAUTC,SCUP
  1.  N SCOKNULL
  1.  S SCOKNULL=1
  1.  S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
  1.  S SDNEXT="",SDCT=0
  1.  S VAUTNA="" ;don't allow all to be selected
  1.  S VAUTCA="" ;allow any clinic to be selected
  1.  S VAUTD=1 ;all divisions
  1.  D CLINIC^SCRPU1 ;prompt for clinics (none,one,many)
  1.  Q:$D(SCUP)  ; "^" SELECTED
  1.  D PRMTT^SCRPU1 ;prompt for team (none,one,many)
  1.  Q:('$D(VAUTT))&('$D(VAUTC))
  1.  Q:$D(SCUP)  ; "^" SELECTED
  1.  S APPTL=$$LENGTH()
  1.  Q:APPTL<0
  1.  S FIRST="First date to check for 1st available appointments: "
  1.  S SECOND="Latest date to check for available appointments: "
  1.  S RANG=$$DTRANG^SCRPU2(FIRST,SECOND)
  1.  I RANG=-1 D CLEAN,EXIT Q
  1.  I $D(VAUTT) D GETCLN(.VAUTT,.VAUTC)
  1.  ;all clinics selected & position assoc clinics in VAUTC(ien)=clinic name
  1.  D DRIVE(.VAUTC,APPTL,RANG)
  1.  D CLEAN,EXIT
  1.  Q
  1. EXIT ;
  1.  K VAUTD,VAUTNA,VAUTT,VAUTC,FIRST,SECOND,RANG,APPTL,SCPCMM,SDNEXT,SDCT
  1.  K VAUTCA,SCUP
  1.  Q
  1.  ;
  1. LENGTH() ;
  1.  ;prompt for appointment length
  1.  N LEN
  1. ST S DIR(0)="N"
  1.  S DIR("A")="Appointment Length Needed "
  1.  D ^DIR
  1.  I Y=""!(X="^")!(X="") S LEN=-1 G EX
  1.  S LEN=X
  1. EX K DIR,Y,X
  1.  Q LEN
  1.  ;
  1. GETCLN(TEAM,CLINIC) ;add assoc. clinics for teams to clinic array
  1.  ;TEAM - team array
  1.  ;CLINIC - clinic array
  1.  ;
  1.  N TM,LIST,ERR,OKAY
  1.  S TM=0,LIST="TPLIST",ERR="ERR1"
  1.  F  S TM=$O(TEAM(TM)) Q:TM=""!(TM'?.N)  D
  1.  .K @LIST,@ERR
  1.  .S OKAY=$$TPTM^SCAPMC24(TM,"","","",LIST,ERR)
  1.  .;@LIST contains all positions for team TM
  1.  .I $G(@LIST@(0))>0 D ADDCL(.CLINIC,LIST)
  1.  Q
  1.  ;
  1. ADDCL(CLINIC,PTLIST) ;add team's associated clinics to clinic list
  1.  ;CLINIC - array of selected clinics
  1.  ;PTLIST - array of all positions for a selected team
  1.  N CNAME,CIEN,TPNODE,TPIEN,NODE,EN
  1.  S EN=0
  1.  F  S EN=$O(@PTLIST@(EN)) Q:EN=""!(EN'?.N)  D
  1.  .S NODE=$G(@PTLIST@(EN))
  1.  .S TPIEN=+$P(NODE,"^") ;team position ien
  1.  .S TPNODE=$G(^SCTM(404.57,TPIEN,0))
  1.  .Q:TPNODE=""
  1.  .Q:'$D(^SCTM(404.57,TPIEN,5,0))  ;no associated clinics
  1.  .S SDA=0  ;SD/549 change logic to pull from new multiple field
  1.  .F  S SDA=$O(^SCTM(404.57,TPIEN,5,SDA)) Q:'SDA  D
  1.  ..Q:'$D(^SCTM(404.57,TPIEN,5,SDA,0))
  1.  ..S CIEN=+$G(^SCTM(404.57,TPIEN,5,SDA,0))
  1.  ..Q:CIEN=0  ;no associated clinic
  1.  ..S CNAME=$P($G(^SC(CIEN,0)),"^")  ;clinic name
  1.  ..S CLINIC(CIEN)=CNAME
  1.  K SDA
  1.  Q
  1.  ;
  1. DRIVE(CLINICA,LEN,BEGEND) ;driver
  1.  ;CLINICA - clinic array
  1.  ;LEN - appt. length wanted
  1.  ;BEGEND - begin date ^ end date
  1.  ;
  1.  N CIEN,COUNT,CONT,FND
  1.  S SDNEXT="",SDCT=1
  1.  S CIEN=0,STOP=0,COUNT=1
  1.  F  S CIEN=$O(CLINICA(CIEN)) Q:CIEN=""!(CIEN'?.N)!(STOP)  D
  1.  .S SDNEXT=""
  1.  .S SDSTRTDT=$P(BEGEND,"^")
  1.  .S SDMAX=$P(BEGEND,"^",2)
  1.  .S SDC(COUNT)=CIEN,SDC1(CIEN)=$G(CLINICA(CIEN))_"^"_LEN
  1.  .S SDCT=COUNT,SC=CIEN,FND=0
  1.  .D OVR^SDMULT0 S CONT=$$CONMA(CIEN,$S($O(CLINICA(CIEN)):0,1:1))
  1.  .K SDC(COUNT),SDC1(CIEN)
  1.  .;S CONT=$$CONMA(CIEN)
  1.  .Q:STOP
  1.  I $G(CONT)="M" D CLEAN S:$$ONE(.CLINICA) SDCLN=$O(CLINICA(0)) G ^SDM
  1.  Q
  1. CLEAN ;
  1.  D END^SDMULT0
  1.  K SDSTRTDT,SDNEXT,SDMAX,SDC,SDCT,SDC1,SDL,STOP,SDAPP,SDPCMM,SDCLN,FND
  1.  K SCPCC,SDPCM1,SC
  1.  Q
  1.  ;
  1. ONE(CLNA) ;one clinic selected? 1 or 0
  1.  N CNT,FIRST,RET,STP
  1.  S (CNT,STP)=0,RET=1
  1.  F  S CNT=$O(CLNA(CNT)) Q:CNT=""!(STP)  D
  1.  .I $D(FIRST) S STOP=1,RET=0
  1.  .I '$D(FIRST) S FIRST=1
  1.  Q RET
  1.  ;
  1. CONMA(CIEN,CONT) ;continue to view, exit or make appointment
  1.  ;
  1. PRT ;
  1.  S CONT=$G(CONT)
  1.  I $G(SDPCMM(CIEN))'>0&('CONT) Q -1
  1.  W !,"'^' TO EXIT"_$S('CONT:", 'C' TO CONTINUE",1:"")_" OR 'M' TO GOTO MAKE APPOINTMENT: "_$S(CONT:"^",1:"CONTINUE")_"//" R X:DTIME
  1.  I '$T!(X="^") S STOP=1,X=-1 G EX2
  1.  I (X'="^")&(X'="C")&(X'="M")&(X'="") G PRT
  1.  I CONT&(X="C") G PRT
  1.  I X="M" S STOP=1
  1.  I X="" S X="C"
  1. EX2 Q X