- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSUTL 2046 printed Jan 18, 2025@03:49:02 Page 2
- 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