SRSUTL.m

SRSUTL ;B'HAM ISC/MAM - SCHEDULING UTILITY ROUTINE; 13 Feb 1989  12:09 PM

 ;;3.0; Surgery ;**37**;24 Jun 93

PATRN ; set pattern in OPERATING ROOM file

 S SRS1=+SRSST,SRS2=+SRSET

 ; algorithm for setting start and end of pattern

 S SRS1=11+((SRS1\1)*5)+(SRS1-(SRS1\1)*100\15),SRS2=11+((SRS2\1)*5)+(SRS2-(SRS2\1)*100\15)

 S S="" F I=SRS1:1:SRS2-1 S S=S_$S('(I#5):"|",$E(SRSSER,I#5)'="":$E(SRSSER,I#5),1:".")

 S X0=^SRS(SRSOR,"SS",SRSDATE,1),(X0,^(1))=$E(X0,1,SRS1)_S_$E(X0,SRS2+1,200),^SRS(SRSOR,"SS",SRSDATE,0)=SRSDATE

 S X1=^SRS(SRSOR,"S",SRSDATE,1) F I=SRS1:1:SRS2 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,^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE

 Q

CONCRNT ; concurrent case check

 W !!,"There is a concurrent case associated with this operation.  Do you want to",!,"schedule it for the same time ? (Y/N)  " R SRBOTH:DTIME I '$T S SRBOTH="^"

 S SRBOTH=$E(SRBOTH) I "^^"[SRBOTH W !!,"This prompt must be answered 'YES' or 'NO'." G CONCRNT

 I "YyNn"'[SRBOTH W !!,"If you want to schedule these operations concurrently, answer 'Y'.  If not,",!,"answer 'N' and these cases will no longer be associated with each other." G CONCRNT

 I "Yy"[SRBOTH S SRBOTH=1

 I SRBOTH'=1 D NOCC

 S SRSCC=1 Q:SRBOTH'=1  S SRTN=$P(^SRF(SRTN,"CON"),"^"),SRSOP=$P(^SRF(SRTN,"OP"),"^")

 Q:'$D(SRUPDT)  K ^SRF("AOR",SRSOR,OLDATE,SRTN) S SRATT=$P(^SRF(SRTN,.1),"^",13)

 S SRTREAT=$P(^SRF(SRTN,0),"^",4) I SRTREAT'="" K ^SRF("ASP",SRTREAT,OLDATE,SRTN) S ^SRF("ASP",SRTREAT,SRSDATE,SRTN)=SRTN

 Q

NOCC ; no longer concurrent cases

 S DIE=130,DR="35///@",DA=$P(^SRF(SRTN,"CON"),"^") D ^DIE S SROERR=$P(^SRF(SRTN,"CON"),"^") D ^SROERR0 S DA=SRTN,DR="35///@" D ^DIE S SROERR=SRTN D ^SROERR0

 I $D(SRTNEW) S DA=SRTNEW,DR="35///@",DIE=130 D ^DIE S SROERR=SRTNEW D ^SROERR0

 Q

OTHER ; other operations

 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."

 I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")

 S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)

 Q

SRSUTL    ;B'HAM ISC/MAM - SCHEDULING UTILITY ROUTINE; 13 Feb 1989  12:09 PM

 +1       ;;3.0; Surgery ;**37**;24 Jun 93

PATRN     ; set pattern in OPERATING ROOM file

 +1        SET SRS1=+SRSST

           SET SRS2=+SRSET

 +2       ; algorithm for setting start and end of pattern

 +3        SET SRS1=11+((SRS1\1)*5)+(SRS1-(SRS1\1)*100\15)

           SET SRS2=11+((SRS2\1)*5)+(SRS2-(SRS2\1)*100\15)

 +4        SET S=""

           FOR I=SRS1:1:SRS2-1

               SET S=S_$SELECT('(I#5):"|",$EXTRACT(SRSSER,I#5)'="":$EXTRACT(SRSSER,I#5),1:".")

 +5        SET X0=^SRS(SRSOR,"SS",SRSDATE,1)

           SET (X0,^(1))=$EXTRACT(X0,1,SRS1)_S_$EXTRACT(X0,SRS2+1,200)

           SET ^SRS(SRSOR,"SS",SRSDATE,0)=SRSDATE

 +6        SET X1=^SRS(SRSOR,"S",SRSDATE,1)

           FOR I=SRS1:1:SRS2

               IF "X="'[$EXTRACT(X1,I)

                   SET X1=$EXTRACT(X1,1,I-1)_$EXTRACT(X0,I)_$EXTRACT(X1,I+1,200)

 +7        SET ^SRS(SRSOR,"S",SRSDATE,1)=X1

           SET ^SRS(SRSOR,"S",SRSDATE,0)=SRSDATE

 +8        QUIT 

CONCRNT   ; concurrent case check

 +1        WRITE !!,"There is a concurrent case associated with this operation.  Do you want to",!,"schedule it for the same time ? (Y/N)  "

           READ SRBOTH:DTIME

           IF '$TEST

               SET SRBOTH="^"

 +2        SET SRBOTH=$EXTRACT(SRBOTH)

           IF "^^"[SRBOTH

               WRITE !!,"This prompt must be answered 'YES' or 'NO'."

               GOTO CONCRNT

 +3        IF "YyNn"'[SRBOTH

               WRITE !!,"If you want to schedule these operations concurrently, answer 'Y'.  If not,",!,"answer 'N' and these cases will no longer be associated with each other."

               GOTO CONCRNT

 +4        IF "Yy"[SRBOTH

               SET SRBOTH=1

 +5        IF SRBOTH'=1

               DO NOCC

 +6        SET SRSCC=1

           IF SRBOTH'=1

               QUIT 

           SET SRTN=$PIECE(^SRF(SRTN,"CON"),"^")

           SET SRSOP=$PIECE(^SRF(SRTN,"OP"),"^")

 +7        IF '$DATA(SRUPDT)

               QUIT 

           KILL ^SRF("AOR",SRSOR,OLDATE,SRTN)

           SET SRATT=$PIECE(^SRF(SRTN,.1),"^",13)

 +8        SET SRTREAT=$PIECE(^SRF(SRTN,0),"^",4)

           IF SRTREAT'=""

               KILL ^SRF("ASP",SRTREAT,OLDATE,SRTN)

               SET ^SRF("ASP",SRTREAT,SRSDATE,SRTN)=SRTN

 +9        QUIT 

NOCC      ; no longer concurrent cases

 +1        SET DIE=130

           SET DR="35///@"

           SET DA=$PIECE(^SRF(SRTN,"CON"),"^")

           DO ^DIE

           SET SROERR=$PIECE(^SRF(SRTN,"CON"),"^")

           DO ^SROERR0

           SET DA=SRTN

           SET DR="35///@"

           DO ^DIE

           SET SROERR=SRTN

           DO ^SROERR0

 +2        IF $DATA(SRTNEW)

               SET DA=SRTNEW

               SET DR="35///@"

               SET DIE=130

               DO ^DIE

               SET SROERR=SRTNEW

               DO ^SROERR0

 +3        QUIT 

OTHER     ; other operations

 +1        SET SRLONG=1

           IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>250

               SET SRLONG=0

               SET OPER=999

               SET SROPERS=" ..."

 +2        IF SRLONG

               SET SROPERS=$PIECE(^SRF(SRTN,13,OPER,0),"^")

 +3        SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)

 +4        QUIT