SRSGRPH.m

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

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