SRSUPRQ ;B'HAM ISC/MAM - UPDATE REQUESTED OPERATIONS; AUGUST 29, 2001@9:04 AM
;;3.0;Surgery;**7,47,58,67,107,114,100,154,177,184,196**;24 Jun 93;Build 1
;
; 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 cases to remain concurrent." G CC
I SRBOTH["Y" S SRBOTH=1
I SRBOTH="^" Q
I $P($G(^SRF(SRCON,.2)),U,12)'="" D Q
.W !!,"The concurrent procedure associated with this case: ",SRCON S SRBOTH=0
.W !,"has been completed and must remain in the file for your records."
.S DA=SRCON,DR="35///@",DIE=130 D ^DIE S SROERR=SRCON D ^SROERR0 S DA=SRTN,DR="35///@",DIE=130 D ^DIE
.K SRCON
.W !!,"Press RETURN to continue " R X:DTIME
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
;JAS - 7/31/13 - Patch 177 (NEXT LINE)
N SRICDV S SRICDV=$$ICDSTR^SROICD(SRTN)
S ST="UPDATE REQUEST",DA=SRTN,DIE=130,DR=$S($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[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
D ^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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSUPRQ 5169 printed Dec 13, 2024@02:47:50 Page 2
SRSUPRQ ;B'HAM ISC/MAM - UPDATE REQUESTED OPERATIONS; AUGUST 29, 2001@9:04 AM
+1 ;;3.0;Surgery;**7,47,58,67,107,114,100,154,177,184,196**;24 Jun 93;Build 1
+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 cases to remain concurrent."
GOTO CC
+3 IF SRBOTH["Y"
SET SRBOTH=1
+4 IF SRBOTH="^"
QUIT
+5 IF $PIECE($GET(^SRF(SRCON,.2)),U,12)'=""
Begin DoDot:1
+6 WRITE !!,"The concurrent procedure associated with this case: ",SRCON
SET SRBOTH=0
+7 WRITE !,"has been completed and must remain in the file for your records."
+8 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
+9 KILL SRCON
+10 WRITE !!,"Press RETURN to continue "
READ X:DTIME
End DoDot:1
QUIT
+11 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
+12 IF SRBOTH'=1
KILL SRCON
+13 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 ;JAS - 7/31/13 - Patch 177 (NEXT LINE)
+4 NEW SRICDV
SET SRICDV=$$ICDSTR^SROICD(SRTN)
+5 SET ST="UPDATE REQUEST"
SET DA=SRTN
SET DIE=130
SET DR=$SELECT($$SPIN^SRTOVRF():"[SRSRES-ENTRY1]",1:"[SRSRES-ENTRY]")
+6 DO EN2^SROVAR
KILL Q3("VIEW"),Y
+7 SET SPD=$$CHKS^SRSCOR(SRTN)
+8 DO ^SRCUSS
+9 IF SPD'=$$CHKS^SRSCOR(SRTN)
SET ^TMP("CSLSUR1",$JOB)=""
+10 KILL DR
if $DATA(SRODR)
DO ^SROCON1
+11 DO RISK^SROAUTL3
+12 DO ^SROPCE1
+13 SET SROERR=SRTN
KILL SRTX
DO ^SROERR0
+14 IF $GET(SRLCK)
DO UNLOCK^SROUTL(SRTN)
+15 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
