- SRSCAN ;B'HAM ISC/MAM - CANCEL SCHEDULED OPERATION;[JAN 30,2001@14:16]
- ;;3.0;Surgery ;**100,201**;24 Jun 93;Build 5
- S SRSOUT=0 W ! K DIC S DIC=2,DIC(0)="AEQM",DIC("A")="Cancel a Scheduled Procedure for which Patient: " D ^DIC K DIC I Y<0 S SRSOUT=1 G END
- S DFN=+Y D DEM^VADPT S SRNAME=VADM(1)_" ("_VA("PID")_")" W @IOF,!,SRNAME,!
- LOOK W ! S (SRTN,CNT)=0 F I=0:0 S SRTN=$O(^SRF("B",DFN,SRTN)) Q:SRTN="" S CNT=CNT+1,SROP1(CNT)=SRTN D LIST
- I '$D(SROP1(1)) D DEM^VADPT W !!,"There are no procedures scheduled for "_VADM(1)_".",!! W !!,"Press RETURN to continue " R X:DTIME G END
- ASK R !!,"Select Number: ",SRNUM:DTIME I '$T!("^"[SRNUM) G END
- I SRNUM["?" W !!,"Enter the number which corresponds to the case that you want to cancel." G ASK
- I '$D(SROP1(SRNUM)) W !!,"You have entered an invalid number, please select again. " G ASK
- S (SRTN,SRTOLD)=SROP1(SRNUM)
- I $D(^SRF(SRTN,.2)),$P(^(.2),"^",2)'="" W !!,$C(7),"This operation already has a start time and cannot be cancelled.",!!,"Press RETURN to continue " R X:DTIME G END
- I $P(^SRF(SRTN,31),"^",4)="" W !!,"This operation is not scheduled." H 1 G END
- D ^SRSCAN1
- OK R !!,"Is this the correct operation ? YES// ",SRYN:DTIME I '$T!(SRYN["^") G END
- S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter RETURN if this is the scheduled procedure that you want",!,"to cancel, or 'NO' to quit this option." G OK
- I "Yy"'[SRYN G END
- ;Modified for SR*3.0*201: call to SRSCHD1 LOCK procedures
- I $$LOCK^SRSCHD1(SRTN) D ^SRSCAN0
- END D ^SRSKILL K SRTN W @IOF
- Q
- OTHER ; other operations
- S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>235 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
- LOOP ; break procedure if greater than 60 characters
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<60 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- LIST ; list cases
- S SRSDATE=$P(^SRF(SRTN,0),"^",9),SRSDATE=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)
- OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F I=0:0 S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
- S SROP=SRTN D ^SROP1
- I SROPER'["SCHEDULED" K SROP1(CNT) S CNT=CNT-1 Q
- K SROPS,MM,MMM S:$L(SROPER)<60 SROPS(1)=SROPER I $L(SROPER)>59 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- W !,CNT_". "_SRSDATE,?15,SROPS(1) I $D(SROPS(2)) W !,?15,SROPS(2) I $D(SROPS(3)) W !,?15,SROPS(3) I $D(SROPS(4)) W !,?15,SROPS(4) I $D(SROPS(5)) W !,?15,SROPS(5)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCAN 2536 printed Mar 13, 2025@21:52:09 Page 2
- SRSCAN ;B'HAM ISC/MAM - CANCEL SCHEDULED OPERATION;[JAN 30,2001@14:16]
- +1 ;;3.0;Surgery ;**100,201**;24 Jun 93;Build 5
- +2 SET SRSOUT=0
- WRITE !
- KILL DIC
- SET DIC=2
- SET DIC(0)="AEQM"
- SET DIC("A")="Cancel a Scheduled Procedure for which Patient: "
- DO ^DIC
- KILL DIC
- IF Y<0
- SET SRSOUT=1
- GOTO END
- +3 SET DFN=+Y
- DO DEM^VADPT
- SET SRNAME=VADM(1)_" ("_VA("PID")_")"
- WRITE @IOF,!,SRNAME,!
- LOOK WRITE !
- SET (SRTN,CNT)=0
- FOR I=0:0
- SET SRTN=$ORDER(^SRF("B",DFN,SRTN))
- if SRTN=""
- QUIT
- SET CNT=CNT+1
- SET SROP1(CNT)=SRTN
- DO LIST
- +1 IF '$DATA(SROP1(1))
- DO DEM^VADPT
- WRITE !!,"There are no procedures scheduled for "_VADM(1)_".",!!
- WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- GOTO END
- ASK READ !!,"Select Number: ",SRNUM:DTIME
- IF '$TEST!("^"[SRNUM)
- GOTO END
- +1 IF SRNUM["?"
- WRITE !!,"Enter the number which corresponds to the case that you want to cancel."
- GOTO ASK
- +2 IF '$DATA(SROP1(SRNUM))
- WRITE !!,"You have entered an invalid number, please select again. "
- GOTO ASK
- +3 SET (SRTN,SRTOLD)=SROP1(SRNUM)
- +4 IF $DATA(^SRF(SRTN,.2))
- IF $PIECE(^(.2),"^",2)'=""
- WRITE !!,$CHAR(7),"This operation already has a start time and cannot be cancelled.",!!,"Press RETURN to continue "
- READ X:DTIME
- GOTO END
- +5 IF $PIECE(^SRF(SRTN,31),"^",4)=""
- WRITE !!,"This operation is not scheduled."
- HANG 1
- GOTO END
- +6 DO ^SRSCAN1
- OK READ !!,"Is this the correct operation ? YES// ",SRYN:DTIME
- IF '$TEST!(SRYN["^")
- GOTO END
- +1 SET SRYN=$EXTRACT(SRYN)
- IF "YyNn"'[SRYN
- WRITE !!,"Enter RETURN if this is the scheduled procedure that you want",!,"to cancel, or 'NO' to quit this option."
- GOTO OK
- +2 IF "Yy"'[SRYN
- GOTO END
- +3 ;Modified for SR*3.0*201: call to SRSCHD1 LOCK procedures
- +4 IF $$LOCK^SRSCHD1(SRTN)
- DO ^SRSCAN0
- END DO ^SRSKILL
- KILL SRTN
- WRITE @IOF
- +1 QUIT
- OTHER ; other operations
- +1 SET SRLONG=1
- IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>235
- 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
- LOOP ; break procedure if greater than 60 characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<60
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- LIST ; list cases
- +1 SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)
- SET SRSDATE=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)
- OPS SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- SET OPER=0
- FOR I=0:0
- SET OPER=$ORDER(^SRF(SRTN,13,OPER))
- if OPER=""
- QUIT
- DO OTHER
- +1 SET SROP=SRTN
- DO ^SROP1
- +2 IF SROPER'["SCHEDULED"
- KILL SROP1(CNT)
- SET CNT=CNT-1
- QUIT
- +3 KILL SROPS,MM,MMM
- if $LENGTH(SROPER)<60
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>59
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +4 WRITE !,CNT_". "_SRSDATE,?15,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?15,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?15,SROPS(3)
- IF $DATA(SROPS(4))
- WRITE !,?15,SROPS(4)
- IF $DATA(SROPS(5))
- WRITE !,?15,SROPS(5)
