- 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 Feb 19, 2025@00:14:19 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