- SRSGRPH ;B'HAM ISC/MAM - STUFF SCHEDULING GRAPH ; 5 DEC 1991 10:00 AM
- ;;3.0; Surgery ;;24 Jun 93
- I '$D(^SRS(SRSOR,"S",SRSDATE,1)) D GRAPH K FLAG,NUMB,P,SRSDAY,SRNUMB,SRXREF,SRX1,SRX2,SRST,SRET,SRDY,X,X1,X2
- S X1=^SRS(SRSOR,"S",SRSDATE,1),(X1,^(1))=$E(X1,1,SRS1)_S_$E(X1,SRS2+1,200),^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE
- S X0=^SRS(SRSOR,"SS",SRSDATE,1)
- F I=SRS1+1:1:SRS2-1 I "X="'[$E(X1,I) S X1=$E(X1,1,I-1)_$E(X0,I)_$E(X1,I+1,200)
- S ^SRS(SRSOR,"S",SRSDATE,1)=X1
- Q
- GRAPH ; set graph in ^SRS
- S ^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE,^SRS(SRSOR,"SS",SRSDATE,0)=SRSDATE
- S ^SRS(SRSOR,"S",SRSDATE,1)=$E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3)_" |____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|"
- S ^SRS(SRSOR,"SS",SRSDATE,1)=^SRS(SRSOR,"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 S SRTIME=$O(^SRS("R",SRDAY,SRSOR,SRTIME)) Q:SRTIME="" S NUMB="" F S NUMB=$O(^SRS("R",SRDAY,SRSOR,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(SRSOR,"S",SRSDATE,1),^(1)=$E(X1,1,SRX1)_P_$E(X1,SRX2+1,200),^SRS(SRSOR,"SS",SRSDATE,1)=^(1),^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE,^SRS(SRSOR,"SS",SRSDATE,0)=SRSDATE Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSGRPH 1840 printed Feb 19, 2025@00:13:59 Page 2
- SRSGRPH ;B'HAM ISC/MAM - STUFF SCHEDULING GRAPH ; 5 DEC 1991 10:00 AM
- +1 ;;3.0; Surgery ;;24 Jun 93
- +2 IF '$DATA(^SRS(SRSOR,"S",SRSDATE,1))
- DO GRAPH
- KILL FLAG,NUMB,P,SRSDAY,SRNUMB,SRXREF,SRX1,SRX2,SRST,SRET,SRDY,X,X1,X2
- +3 SET X1=^SRS(SRSOR,"S",SRSDATE,1)
- SET (X1,^(1))=$EXTRACT(X1,1,SRS1)_S_$EXTRACT(X1,SRS2+1,200)
- SET ^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE
- +4 SET X0=^SRS(SRSOR,"SS",SRSDATE,1)
- +5 FOR I=SRS1+1:1:SRS2-1
- IF "X="'[$EXTRACT(X1,I)
- SET X1=$EXTRACT(X1,1,I-1)_$EXTRACT(X0,I)_$EXTRACT(X1,I+1,200)
- +6 SET ^SRS(SRSOR,"S",SRSDATE,1)=X1
- +7 QUIT
- GRAPH ; set graph in ^SRS
- +1 SET ^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE
- SET ^SRS(SRSOR,"SS",SRSDATE,0)=SRSDATE
- +2 SET ^SRS(SRSOR,"S",SRSDATE,1)=$EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_$EXTRACT(SRSDATE,2,3)_" |____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|____|"
- +3 SET ^SRS(SRSOR,"SS",SRSDATE,1)=^SRS(SRSOR,"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
- SET SRTIME=$ORDER(^SRS("R",SRDAY,SRSOR,SRTIME))
- if SRTIME=""
- QUIT
- SET NUMB=""
- FOR
- SET NUMB=$ORDER(^SRS("R",SRDAY,SRSOR,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(SRSOR,"S",SRSDATE,1)
- SET ^(1)=$EXTRACT(X1,1,SRX1)_P_$EXTRACT(X1,SRX2+1,200)
- SET ^SRS(SRSOR,"SS",SRSDATE,1)=^(1)
- SET ^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE
- SET ^SRS(SRSOR,"SS",SRSDATE,0)=SRSDATE
- QUIT
- +8 QUIT