SRSAVL ;B'HAM ISC/MAM - DISPLAY AVAILABILITY ; [ 09/22/98 11:36 AM ]
;;3.0; Surgery ;**77,50,165**;24 Jun 93;Build 6
START K SRSDATE S SRSOUT=0,SRBPRG=1 D CURRENT^SRSBUTL
S X="IOPTCH10;IOPTCH16" D ENDR^%ZISS S SR10=IOPTCH10,SR16=IOPTCH16 D KILL^%ZISS
W @IOF,!,"Do you want to view all Operating Rooms on one day ? YES // " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I "YyNn"'[SRYN W !!,"Enter RETURN if you want to view the availabilty of all operating rooms for a",!,"particular date, or 'NO' to view the availability of one specific operating",!,"room over a two week period."
I "YyNn"'[SRYN W !!,"Press RETURN to continue " R X:DTIME G START
I "Yy"[SRYN D REQ G:SRSOUT END D:SREQ ^SRSAVL1 G END
W !! K %DT S %DT="AEFX",%DT("A")="Begin Display on which Date ? " D ^%DT I Y<0 S SRSOUT=1 G END
S SRSDATE=+Y,SR1DAY=1
W !! K DIC S DIC="^SRS(",DIC(0)="QEAMZ",DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),('$P(^(0),""^"",6))" D ^DIC I Y<0 S SRSOUT=1 G END
S SROR=+Y,SROOM=$P(Y(0),"^"),SROOM=$P(^SC(SROOM,0),"^") I SR16="" D ^SRSDIS1 G END
S IOP=IO_";132",%ZIS="" D ^%ZIS W SR16
W @IOF,!,"Operating Room: "_SROOM,!!," DATE 12 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"
S SRDT=SRSDATE F SRDAZE=0:1:14 S X1=SRDT,X2=SRDAZE D C^%DTC S SRSDATE=X,SRDATE=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)_" " D LINE
END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
S IOP=IO_";80",%ZIS="" D ^%ZIS W SR10 W @IOF K SRTN,SRBFLG,SRBSER1,SRBPRG D ^SRSKILL
Q
REQ ; list requests ?
S SREQ=0 W !!,"Do you want to list requests also ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="N"
I "YyNn"'[SRYN W !!,"Enter RETURN if you only want to view the availability of operating",!,"rooms, or 'YES' to also list requested cases for the date selected.",! G REQ
I "Yy"[SRYN S SREQ=1
K SR1DAY I '$D(SRSDATE) W ! K %DT S %DT="AEFX",%DT("A")="Display Operating Room Availability for which Date ? " D ^%DT S:+Y SRSDATE=+Y I Y<0 S SRSOUT=1 Q
I SR16="" D ^SRSDISP Q
S IOP=IO_";132",%ZIS="" D ^%ZIS W SR16
W @IOF,!!,"ROOM 12 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"
S SROR=0 F S SROR=$O(^SRS(SROR)) Q:'SROR I '$P(^(SROR,0),"^",6) D:$$ORDIV^SROUTL0(SROR,SRSITE("DIV")) LINE
Q
LINE I '$D(^SRS(SROR,"S",SRSDATE,1)) D GRAPH
S SROR1=$P(^SRS(SROR,0),"^"),SROR1=$P(^SC(SROR1,0),"^")
W !,$S($D(SR1DAY):SRDATE,1:$E(SROR1,1,6)),?8,$E(^SRS(SROR,"S",SRSDATE,1),11,200)
Q
GRAPH ; set graph in ^SRS
S ^SRS(SROR,"S",SRSDATE,0)=SRSDATE,^SRS(SROR,"SS",SRSDATE,0)=SRSDATE
S ^SRS(SROR,"S",SRSDATE,1)=$E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3)_" |____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|"
S ^SRS(SROR,"SS",SRSDATE,1)=^SRS(SROR,"S",SRSDATE,1)
S X1=SRSDATE,X2=2830103 D ^%DTC S SRDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1),X3=X#2+8 S X1=SRSDATE,X2=$E(SRSDATE,1,5)_"01" D ^%DTC S SRDY=X\7+1
S SRTIME=0 F I=0:0 S SRTIME=$O(^SRS("R",SRDAY,SROR,SRTIME)) Q:SRTIME="" S NUMB="" F I=0:0 S NUMB=$O(^SRS("R",SRDAY,SROR,SRTIME,NUMB)) Q:NUMB="" S SRXREF=^(NUMB),SRSDAY=$P(SRXREF,"^",2) S SRNUMB=$E(SRSDAY,3),FLAG=0 D CHNG
Q
CHNG ; change graph
I SRSDAY[SRDAY,SRDY=4,SRNUMB=5 S X1=SRSDATE,X2=7,X5=$E(SRSDATE,4,5) D C^%DTC I $E(X,4,5)'=X5 S FLAG=1
I 'FLAG,SRSDAY[SRDAY,(SRNUMB=0!(SRNUMB=SRDY))!(SRNUMB=X3) S FLAG=1
I 'FLAG Q
S SRST=$P(SRXREF,"^",3),SRET=$P(SRXREF,"^",4),SERV=$P(SRXREF,"^",5),P=""
S SRX1=11+((SRST\1)*5)+(SRST-(SRST\1)*100\15),SRX2=11+((SRET\1)*5)+(SRET-(SRET\1)*100\15)
F X=SRX1:1:SRX2-1 S P=P_$S('(X#5):"|",$E(SERV,X#5)'="":$E(SERV,X#5),1:".")
S X1=^SRS(SROR,"S",SRSDATE,1),^(1)=$E(X1,1,SRX1)_P_$E(X1,SRX2+1,200),^SRS(SROR,"SS",SRSDATE,1)=^(1),^SRS(SROR,"S",SRSDATE,0)=SRSDATE,^SRS(SROR,"SS",SRSDATE,0)=SRSDATE Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSAVL 4004 printed Nov 22, 2024@17:56:49 Page 2
SRSAVL ;B'HAM ISC/MAM - DISPLAY AVAILABILITY ; [ 09/22/98 11:36 AM ]
+1 ;;3.0; Surgery ;**77,50,165**;24 Jun 93;Build 6
START KILL SRSDATE
SET SRSOUT=0
SET SRBPRG=1
DO CURRENT^SRSBUTL
+1 SET X="IOPTCH10;IOPTCH16"
DO ENDR^%ZISS
SET SR10=IOPTCH10
SET SR16=IOPTCH16
DO KILL^%ZISS
+2 WRITE @IOF,!,"Do you want to view all Operating Rooms on one day ? YES // "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
GOTO END
+3 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+4 IF "YyNn"'[SRYN
WRITE !!,"Enter RETURN if you want to view the availabilty of all operating rooms for a",!,"particular date, or 'NO' to view the availability of one specific operating",!,"room over a two week period."
+5 IF "YyNn"'[SRYN
WRITE !!,"Press RETURN to continue "
READ X:DTIME
GOTO START
+6 IF "Yy"[SRYN
DO REQ
if SRSOUT
GOTO END
if SREQ
DO ^SRSAVL1
GOTO END
+7 WRITE !!
KILL %DT
SET %DT="AEFX"
SET %DT("A")="Begin Display on which Date ? "
DO ^%DT
IF Y<0
SET SRSOUT=1
GOTO END
+8 SET SRSDATE=+Y
SET SR1DAY=1
+9 WRITE !!
KILL DIC
SET DIC="^SRS("
SET DIC(0)="QEAMZ"
SET DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),('$P(^(0),""^"",6))"
DO ^DIC
IF Y<0
SET SRSOUT=1
GOTO END
+10 SET SROR=+Y
SET SROOM=$PIECE(Y(0),"^")
SET SROOM=$PIECE(^SC(SROOM,0),"^")
IF SR16=""
DO ^SRSDIS1
GOTO END
+11 SET IOP=IO_";132"
SET %ZIS=""
DO ^%ZIS
WRITE SR16
+12 WRITE @IOF,!,"Operating Room: "_SROOM,!!," DATE 12 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"
+13 SET SRDT=SRSDATE
FOR SRDAZE=0:1:14
SET X1=SRDT
SET X2=SRDAZE
DO C^%DTC
SET SRSDATE=X
SET SRDATE=$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)_"-"_$EXTRACT(X,2,3)_" "
DO LINE
END IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+1 SET IOP=IO_";80"
SET %ZIS=""
DO ^%ZIS
WRITE SR10
WRITE @IOF
KILL SRTN,SRBFLG,SRBSER1,SRBPRG
DO ^SRSKILL
+2 QUIT
REQ ; list requests ?
+1 SET SREQ=0
WRITE !!,"Do you want to list requests also ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+2 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="N"
+3 IF "YyNn"'[SRYN
WRITE !!,"Enter RETURN if you only want to view the availability of operating",!,"rooms, or 'YES' to also list requested cases for the date selected.",!
GOTO REQ
+4 IF "Yy"[SRYN
SET SREQ=1
+5 KILL SR1DAY
IF '$DATA(SRSDATE)
WRITE !
KILL %DT
SET %DT="AEFX"
SET %DT("A")="Display Operating Room Availability for which Date ? "
DO ^%DT
if +Y
SET SRSDATE=+Y
IF Y<0
SET SRSOUT=1
QUIT
+6 IF SR16=""
DO ^SRSDISP
QUIT
+7 SET IOP=IO_";132"
SET %ZIS=""
DO ^%ZIS
WRITE SR16
+8 WRITE @IOF,!!,"ROOM 12 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"
+9 SET SROR=0
FOR
SET SROR=$ORDER(^SRS(SROR))
if 'SROR
QUIT
IF '$PIECE(^(SROR,0),"^",6)
if $$ORDIV^SROUTL0(SROR,SRSITE("DIV"))
DO LINE
+10 QUIT
LINE IF '$DATA(^SRS(SROR,"S",SRSDATE,1))
DO GRAPH
+1 SET SROR1=$PIECE(^SRS(SROR,0),"^")
SET SROR1=$PIECE(^SC(SROR1,0),"^")
+2 WRITE !,$SELECT($DATA(SR1DAY):SRDATE,1:$EXTRACT(SROR1,1,6)),?8,$EXTRACT(^SRS(SROR,"S",SRSDATE,1),11,200)
+3 QUIT
GRAPH ; set graph in ^SRS
+1 SET ^SRS(SROR,"S",SRSDATE,0)=SRSDATE
SET ^SRS(SROR,"SS",SRSDATE,0)=SRSDATE
+2 SET ^SRS(SROR,"S",SRSDATE,1)=$EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_$EXTRACT(SRSDATE,2,3)_" |____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|"
+3 SET ^SRS(SROR,"SS",SRSDATE,1)=^SRS(SROR,"S",SRSDATE,1)
+4 SET X1=SRSDATE
SET X2=2830103
DO ^%DTC
SET SRDAY=$PIECE("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
SET X3=X#2+8
SET X1=SRSDATE
SET X2=$EXTRACT(SRSDATE,1,5)_"01"
DO ^%DTC
SET SRDY=X\7+1
+5 SET SRTIME=0
FOR I=0:0
SET SRTIME=$ORDER(^SRS("R",SRDAY,SROR,SRTIME))
if SRTIME=""
QUIT
SET NUMB=""
FOR I=0:0
SET NUMB=$ORDER(^SRS("R",SRDAY,SROR,SRTIME,NUMB))
if NUMB=""
QUIT
SET SRXREF=^(NUMB)
SET SRSDAY=$PIECE(SRXREF,"^",2)
SET SRNUMB=$EXTRACT(SRSDAY,3)
SET FLAG=0
DO CHNG
+6 QUIT
CHNG ; change graph
+1 IF SRSDAY[SRDAY
IF SRDY=4
IF SRNUMB=5
SET X1=SRSDATE
SET X2=7
SET X5=$EXTRACT(SRSDATE,4,5)
DO C^%DTC
IF $EXTRACT(X,4,5)'=X5
SET FLAG=1
+2 IF 'FLAG
IF SRSDAY[SRDAY
IF (SRNUMB=0!(SRNUMB=SRDY))!(SRNUMB=X3)
SET FLAG=1
+3 IF 'FLAG
QUIT
+4 SET SRST=$PIECE(SRXREF,"^",3)
SET SRET=$PIECE(SRXREF,"^",4)
SET SERV=$PIECE(SRXREF,"^",5)
SET P=""
+5 SET SRX1=11+((SRST\1)*5)+(SRST-(SRST\1)*100\15)
SET SRX2=11+((SRET\1)*5)+(SRET-(SRET\1)*100\15)
+6 FOR X=SRX1:1:SRX2-1
SET P=P_$SELECT('(X#5):"|",$EXTRACT(SERV,X#5)'="":$EXTRACT(SERV,X#5),1:".")
+7 SET X1=^SRS(SROR,"S",SRSDATE,1)
SET ^(1)=$EXTRACT(X1,1,SRX1)_P_$EXTRACT(X1,SRX2+1,200)
SET ^SRS(SROR,"SS",SRSDATE,1)=^(1)
SET ^SRS(SROR,"S",SRSDATE,0)=SRSDATE
SET ^SRS(SROR,"SS",SRSDATE,0)=SRSDATE
QUIT
+8 QUIT
