SRSBLOK ;B'HAM ISC/MAM - SERVICE BLOCKS ; 25 NOV 1991 10:45 AM
;;3.0; Surgery ;;24 Jun 93
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[HSRSBLOK 1094 printed Dec 13, 2024@02:46:55 Page 2
SRSBLOK ;B'HAM ISC/MAM - SERVICE BLOCKS ; 25 NOV 1991 10:45 AM
+1 ;;3.0; Surgery ;;24 Jun 93
+2 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
+3 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
+4 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
