SRSUPRQ ;B'HAM ISC/MAM - UPDATE REQUESTED OPERATIONS; [ 08/29/01 9:04 AM ]
;;3.0; Surgery ;**7,47,58,67,107,114,100,154**;24 Jun 93
;
; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
;
K SRSCHED
ASK K DIC,SRCASE S SRSOUT=0,DIC=2,DIC(0)="QEAMZ",DIC("A")="Select Patient: " D ^DIC K DIC Q:Y<0 S SRDFN=+Y,SRNM=$P(Y(0),"^")
S (CNT,SRSDATE,SRTN)=0 F S SRSDATE=$O(^SRF("AR",SRSDATE)) Q:'SRSDATE F S SRTN=$O(^SRF("AR",SRSDATE,SRDFN,SRTN)) Q:'SRTN D SETUP
I '$D(SRCASE(1)) W !!,"There are no requested cases for "_SRNM_"." G END
S GRAMMER=$S($D(SRCASE(2)):"cases are",1:"case is") W @IOF,!,"The following "_GRAMMER_" requested for "_SRNM_":",!
S CNT=0 F S CNT=$O(SRCASE(CNT)) Q:'CNT D OPS W !,$P(SRCASE(CNT),"^",2),?15,SROPS(1) I $D(SROPS(2)) W !,?15,SROPS(2) I $D(SROPS(3)) W !,?15,SROPS(3)
OPT S SREQ=1 I $D(SRCASE(2)) D MANY
G:"^"[SREQ END S:'$D(SRCASE(2)) SRTN=$P(SRCASE(1),"^") S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7) I $P(^SRF(SRTN,0),"^",4)="" D SS^SRSCHUP I SRSOUT K SRTN
Q:$D(SRSCHED) G:'$D(SRTN) END W !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date"
SEL W !!,"Select Number: " R Z:DTIME S:'$T!("^"[Z) SRSOUT=1 G:SRSOUT END S:Z["?" Z=4
I Z<1!(Z>3)!(+Z\1'=Z) W !!,"If you want to delete this request, enter '1'. Enter '2' if you only want",!,"to update the general information about this case, or '3' to change the date",!,"that this case is requested for." G SEL
I $D(^XTMP("SRLOCK-"_SRTN)) D MSG G END
I Z=1 D DEL G END
I Z=2 D UPDATE S SRSOUT=1 G END
I Z=3 D CHANGE^SRSDT
END I '$D(SRLATE) S SRLATE=0
I 'SRLATE,'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
W @IOF D ^SRSKILL K SRTN,SRTN1,SRTNX
Q
OPS S SROPER=$P(SRCASE(CNT),"^",3) 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=""
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
MANY ; select requested case if more than one
W !!,"Select Operation Request: " R SREQ:DTIME S:'$T SREQ="^" Q:"^"[SREQ I SREQ["?"!'$D(SRCASE(SREQ)) W !!,"Enter the number corresponding to the request that will be updated or deleted. " G MANY
S SRTN=$P(SRCASE(SREQ),"^")
Q
SETUP ; set SRCASE array to list requested cases for this patient
S CNT=CNT+1,SRSDT=$P(^SRF(SRTN,0),"^",9),SRSDT=$E(SRSDT,4,5)_"-"_$E(SRSDT,6,7)_"-"_$E(SRSDT,2,3),SRCASE(CNT)=SRTN_"^"_CNT_". "_SRSDT_"^"_$P(^SRF(SRTN,"OP"),"^")
Q
DEL ; delete request
S SRBOTH=0 W !!,"Are you sure that you want to delete this request ? YES// " R X:DTIME S:'$T X="N" S:X="" X="Y" I X["?" W !!,"Enter RETURN if this request is to be deleted, or NO to quit. " G DEL
S X=$E(X) Q:"Yy"'[X I '$$LOCK^SROUTL(SRTN) Q
K DIE,DR,DA S DA=SRTN,DIE=130,DR="36///0;Q;.09///"_SRSDATE D ^DIE K DR,DA,DIE S SRSDOC=$P(^SRF(SRTN,.1),"^",4)
S SRCON=$P($G(^SRF(SRTN,"CON")),"^") I SRCON D CON I SRBOTH="^" G END
OPALSO ; delete from file 130
S SROPCOM="Operation ..."
S DFN=SRDFN,SRCC="",SRTNX=SRTN D KILL^SROPDEL,UNLOCK^SROUTL(SRTNX) S SRTN=SRTN1 I $D(SRCON) S SRC="" G:"^"[SRBOTH END I SRBOTH=1 S SRTN=SRCON,SRCC="Concurrent " D KILL^SROPDEL,UNLOCK^SROUTL(SRCON)
Q
CON S SRCON=^SRF(SRTN,"CON"),SRC="the request for" D CC Q:SRBOTH="^" I SRBOTH=1 K DIE,DR,DA S DA=SRCON,DIE=130,DR="36///0;Q;.09///"_SRSDATE D ^DIE K DR,DIE,DA S SRSDOCC=$P(^SRF(SRCON,.1),"^",4)
Q
CC ; check to see if concurrent case should be deleted
W !!,"A concurrent case has been requested for this operation. Do you want to",!,"delete "_SRC_" it also ? YES// " R SRBOTH:DTIME S:'$T SRBOTH="^" I SRBOTH["?" W !!,"Enter 'Y' if you want to delete "_SRC_" concurrent case." G CC
S:SRBOTH="" SRBOTH="Y" S SRBOTH=$E(SRBOTH) I "YyNn"'[SRBOTH W !!,"Enter RETURN if you want these case to remain concurrent." G CC
I SRBOTH["Y" S SRBOTH=1
S DA=SRCON,DR="35///@",DIE=130 D ^DIE S SROERR=SRCON D ^SROERR0 S DA=SRTN,DR="35///@",DIE=130 D ^DIE
I SRBOTH'=1 K SRCON
Q
UPDATE ; update requested operation
N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) Q:'SRLCK
D AVG^SRSREQ D RT K SRLNTH,SRLNTH1,DR,X
S ST="UPDATE REQUEST",DA=SRTN,DIE=130,DR="[SRSRES-ENTRY]" D EN2^SROVAR K Q3("VIEW"),Y S SPD=$$CHKS^SRSCOR(SRTN) D ^SRCUSS I SPD'=$$CHKS^SRSCOR(SRTN) S ^TMP("CSLSUR1",$J)=""
K DR D:$D(SRODR) ^SROCON1 D RISK^SROAUTL3,^SROPCE1
S SROERR=SRTN K SRTX D ^SROERR0
I $G(SRLCK) D UNLOCK^SROUTL(SRTN)
Q
RT ; start RT logging
I $D(XRTL) S XRTN="SRSUPRQ" D T0^%ZOSV
Q
MSG W !!,"This case is currently being edited.",!,"Please try again later...",!! Q
SRSUPRQ ;B'HAM ISC/MAM - UPDATE REQUESTED OPERATIONS; [ 08/29/01 9:04 AM ]
+1 ;;3.0; Surgery ;**7,47,58,67,107,114,100,154**;24 Jun 93
+2 ;
+3 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
+4 ;
+5 KILL SRSCHED
ASK KILL DIC,SRCASE
SET SRSOUT=0
SET DIC=2
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Patient: "
DO ^DIC
KILL DIC
IF Y<0
QUIT
SET SRDFN=+Y
SET SRNM=$PIECE(Y(0),"^")
+1 SET (CNT,SRSDATE,SRTN)=0
FOR
SET SRSDATE=$ORDER(^SRF("AR",SRSDATE))
IF 'SRSDATE
QUIT
FOR
SET SRTN=$ORDER(^SRF("AR",SRSDATE,SRDFN,SRTN))
IF 'SRTN
QUIT
DO SETUP
+2 IF '$DATA(SRCASE(1))
WRITE !!,"There are no requested cases for "_SRNM_"."
GOTO END
+3 SET GRAMMER=$SELECT($DATA(SRCASE(2)):"cases are",1:"case is")
WRITE @IOF,!,"The following "_GRAMMER_" requested for "_SRNM_":",!
+4 SET CNT=0
FOR
SET CNT=$ORDER(SRCASE(CNT))
IF 'CNT
QUIT
DO OPS
WRITE !,$PIECE(SRCASE(CNT),"^",2),?15,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?15,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?15,SROPS(3)
OPT SET SREQ=1
IF $DATA(SRCASE(2))
DO MANY
+1 IF "^"[SREQ
GOTO END
IF '$DATA(SRCASE(2))
SET SRTN=$PIECE(SRCASE(1),"^")
SET SRSDATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
IF $PIECE(^SRF(SRTN,0),"^",4)=""
DO SS^SRSCHUP
IF SRSOUT
KILL SRTN
+2 IF $DATA(SRSCHED)
QUIT
IF '$DATA(SRTN)
GOTO END
WRITE !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date"
SEL WRITE !!,"Select Number: "
READ Z:DTIME
IF '$TEST!("^"[Z)
SET SRSOUT=1
IF SRSOUT
GOTO END
IF Z["?"
SET Z=4
+1 IF Z<1!(Z>3)!(+Z\1'=Z)
WRITE !!,"If you want to delete this request, enter '1'. Enter '2' if you only want",!,"to update the general information about this case, or '3' to change the date",!,"that this case is requested for."
GOTO SEL
+2 IF $DATA(^XTMP("SRLOCK-"_SRTN))
DO MSG
GOTO END
+3 IF Z=1
DO DEL
GOTO END
+4 IF Z=2
DO UPDATE
SET SRSOUT=1
GOTO END
+5 IF Z=3
DO CHANGE^SRSDT
END IF '$DATA(SRLATE)
SET SRLATE=0
+1 IF 'SRLATE
IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+2 WRITE @IOF
DO ^SRSKILL
KILL SRTN,SRTN1,SRTNX
+3 QUIT
OPS SET SROPER=$PIECE(SRCASE(CNT),"^",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
+1 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
MANY ; select requested case if more than one
+1 WRITE !!,"Select Operation Request: "
READ SREQ:DTIME
IF '$TEST
SET SREQ="^"
IF "^"[SREQ
QUIT
IF SREQ["?"!'$DATA(SRCASE(SREQ))
WRITE !!,"Enter the number corresponding to the request that will be updated or deleted. "
GOTO MANY
+2 SET SRTN=$PIECE(SRCASE(SREQ),"^")
+3 QUIT
SETUP ; set SRCASE array to list requested cases for this patient
+1 SET CNT=CNT+1
SET SRSDT=$PIECE(^SRF(SRTN,0),"^",9)
SET SRSDT=$EXTRACT(SRSDT,4,5)_"-"_$EXTRACT(SRSDT,6,7)_"-"_$EXTRACT(SRSDT,2,3)
SET SRCASE(CNT)=SRTN_"^"_CNT_". "_SRSDT_"^"_$PIECE(^SRF(SRTN,"OP"),"^")
+2 QUIT
DEL ; delete request
+1 SET SRBOTH=0
WRITE !!,"Are you sure that you want to delete this request ? YES// "
READ X:DTIME
IF '$TEST
SET X="N"
IF X=""
SET X="Y"
IF X["?"
WRITE !!,"Enter RETURN if this request is to be deleted, or NO to quit. "
GOTO DEL
+2 SET X=$EXTRACT(X)
IF "Yy"'[X
QUIT
IF '$$LOCK^SROUTL(SRTN)
QUIT
+3 KILL DIE,DR,DA
SET DA=SRTN
SET DIE=130
SET DR="36///0;Q;.09///"_SRSDATE
DO ^DIE
KILL DR,DA,DIE
SET SRSDOC=$PIECE(^SRF(SRTN,.1),"^",4)
+4 SET SRCON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF SRCON
DO CON
IF SRBOTH="^"
GOTO END
OPALSO ; delete from file 130
+1 SET SROPCOM="Operation ..."
+2 SET DFN=SRDFN
SET SRCC=""
SET SRTNX=SRTN
DO KILL^SROPDEL
DO UNLOCK^SROUTL(SRTNX)
SET SRTN=SRTN1
IF $DATA(SRCON)
SET SRC=""
IF "^"[SRBOTH
GOTO END
IF SRBOTH=1
SET SRTN=SRCON
SET SRCC="Concurrent "
DO KILL^SROPDEL
DO UNLOCK^SROUTL(SRCON)
+3 QUIT
CON SET SRCON=^SRF(SRTN,"CON")
SET SRC="the request for"
DO CC
IF SRBOTH="^"
QUIT
IF SRBOTH=1
KILL DIE,DR,DA
SET DA=SRCON
SET DIE=130
SET DR="36///0;Q;.09///"_SRSDATE
DO ^DIE
KILL DR,DIE,DA
SET SRSDOCC=$PIECE(^SRF(SRCON,.1),"^",4)
+1 QUIT
CC ; check to see if concurrent case should be deleted
+1 WRITE !!,"A concurrent case has been requested for this operation. Do you want to",!,"delete "_SRC_" it also ? YES// "
READ SRBOTH:DTIME
IF '$TEST
SET SRBOTH="^"
IF SRBOTH["?"
WRITE !!,"Enter 'Y' if you want to delete "_SRC_" concurrent case."
GOTO CC
+2 IF SRBOTH=""
SET SRBOTH="Y"
SET SRBOTH=$EXTRACT(SRBOTH)
IF "YyNn"'[SRBOTH
WRITE !!,"Enter RETURN if you want these case to remain concurrent."
GOTO CC
+3 IF SRBOTH["Y"
SET SRBOTH=1
+4 SET DA=SRCON
SET DR="35///@"
SET DIE=130
DO ^DIE
SET SROERR=SRCON
DO ^SROERR0
SET DA=SRTN
SET DR="35///@"
SET DIE=130
DO ^DIE
+5 IF SRBOTH'=1
KILL SRCON
+6 QUIT
UPDATE ; update requested operation
+1 NEW SRLCK
SET SRLCK=$$LOCK^SROUTL(SRTN)
IF 'SRLCK
QUIT
+2 DO AVG^SRSREQ
DO RT
KILL SRLNTH,SRLNTH1,DR,X
+3 SET ST="UPDATE REQUEST"
SET DA=SRTN
SET DIE=130
SET DR="[SRSRES-ENTRY]"
DO EN2^SROVAR
KILL Q3("VIEW"),Y
SET SPD=$$CHKS^SRSCOR(SRTN)
DO ^SRCUSS
IF SPD'=$$CHKS^SRSCOR(SRTN)
SET ^TMP("CSLSUR1",$JOB)=""
+4 KILL DR
IF $DATA(SRODR)
DO ^SROCON1
DO RISK^SROAUTL3
DO ^SROPCE1
+5 SET SROERR=SRTN
KILL SRTX
DO ^SROERR0
+6 IF $GET(SRLCK)
DO UNLOCK^SROUTL(SRTN)
+7 QUIT
RT ; start RT logging
+1 IF $DATA(XRTL)
SET XRTN="SRSUPRQ"
DO T0^%ZOSV
+2 QUIT
MSG WRITE !!,"This case is currently being edited.",!,"Please try again later...",!!
QUIT
