SROPDEL ;BIR/MAM - DELETE CASE; JUNE 14, 2005
;;3.0;Surgery;**67,100,142,167,207**;24 Jun 93;Build 1
DEL W !!,"Are you sure that you want to delete this case ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S:SRYN="" SRYN="N" S SRYN=$E(SRYN)
I "YyNn"'[SRYN W !!,"Enter 'YES' to delete this surgical case from your records. If you have",!,"selected this option inadvertantly and do not want to remove this case,",!,"enter RETURN or 'NO'." G DEL
I "Yy"'[SRYN S SRSOUT=1 Q
S SRCC="",SROPCOM="Operation..."
I $P($G(^SRF(SRTN,.2)),"^",12)'="" W !!,"This case has been completed and must remain in the file for your records." D RET Q
I $D(^SRF(SRTN,"LOCK")),^("LOCK")=1 W !!,"This case has been verified and locked. It cannot be deleted unless unlocked",!,"by your Chief of Surgery, or someone appointed by him/her." D RET Q
I $P($G(^SRF(SRTN,30)),"^") S SROPCAN=1
I $P($G(^SRF(SRTN,31)),"^",8)'="" S SROPCAN=1
I $D(SROPCAN) W !!,"This case has been cancelled and must remain in the file for your records." D RET Q
I $P($G(^SRF(SRTN,31)),"^",4) W !!,"You cannot delete a procedure that has already been scheduled. If you",!,"would like to cancel this procedure, use the option 'Cancel Scheduled ",!,"Operation'." D RET Q
S Y=$G(^SRF(SRTN,"TIU")) I $P(Y,"^")!$P(Y,"^",2)!$P(Y,"^",4) W !!,"You cannot delete a procedure that has one or more operative documents." D RET Q
K ^TMP("SRTP",$J) D TP I SRSOUT=1 Q ;checking associated transplant assessments
KILL ; delete entry
Q:'$$LOCK^SROUTL(SRTN)
S SRCONC=$P($G(^SRF(SRTN,"CON")),"^") I SRCONC K ^SRF(SRCONC,"CON")
D DEL^SROERR
W !!," Deleting "_SRCC_SROPCOM I $P($G(^SRF(SRTN,.2)),"^",10) S DIE=130,DA=SRTN,DR=".205///@" D ^DIE K DA
S SRX=$P($G(^SRF(SRTN,0)),"^",15) I SRX S SRVSIT=SRX D DEL^SROPCEP ; delete visit
I $D(^SRO(136,SRTN,0)) S DA=SRTN,DIK="^SRO(136," D ^DIK K DA,DIK ; remove entry in file 136
S (DA,SRTN1)=SRTN,DIK="^SRF(" D ^DIK,UNLOCK^SROUTL(SRTN) K DA,DIK,SRTN
I SRCONC D UNLOCK^SROUTL(SRCONC),CON I SRCONC D KILL
I $D(^TMP("SRTP",$J)) D KTP
Q
CON ; delete concurrent case ?
S SRTN=SRCONC W !!,"There is a concurrent procedure associated with this case. Do you want to",!,"delete it also ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRCONC=0 Q
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I $P($G(^SRF(SRTN,.2)),U,12)'="" D S SRCONC=0 Q ;SR207: check if case complete
.W !!,"The concurrent procedure associated with this case: ",SRCONC
.W !,"has been completed and must remain in the file for your records."
.W !!,"Press RETURN to continue " R X:DTIME
I "YyNn"'[SRYN W !!,"Enter RETURN to delete this concurrent case. If you are not sure whether to",!,"delete the other case, enter 'NO'. It can be removed later if necessary." G CON
I "Nn"[SRYN S SRCONC=0
Q
RET W !!,"Press RETURN to continue " R X:DTIME K SRTN
Q
TP N SRATP,SRTPN,SRTPP S SRATP=0
F S SRATP=$O(^SRT("B",DFN,SRATP)) Q:'SRATP S SRTPN=$G(^SRT(SRATP,0)) S:$P(SRTPN,"^",3)=SRTN ^TMP("SRTP",$J,SRATP)=""
Q:'$D(^TMP("SRTP",$J))
W !!,"Deleting this case will also delete the transplant assessment(s) associated",!,"with this case. Are you sure you want to delete this case? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S:SRYN="" SRYN="N" S SRYN=$E(SRYN)
I "YyNn"'[SRYN W !!,"Enter YES to delete this case and its transplant assessment(s). Otherwise,",!,"enter NO." G TP
I "Yy"'[SRYN S SRSOUT=1 Q
Q
KTP ; delete transplant assessments
S SRTPP=0 F S SRTPP=$O(^TMP("SRTP",$J,SRTPP)) Q:'SRTPP D
.K DA,DIK S DA=SRTPP,DIK="^SRT(" D ^DIK K DA,DIK W !!,"Deleting Transplant Assessment #",SRTPP
K ^TMP("SRTP",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPDEL 3632 printed Dec 13, 2024@02:44:59 Page 2
SROPDEL ;BIR/MAM - DELETE CASE; JUNE 14, 2005
+1 ;;3.0;Surgery;**67,100,142,167,207**;24 Jun 93;Build 1
DEL WRITE !!,"Are you sure that you want to delete this case ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+1 if SRYN=""
SET SRYN="N"
SET SRYN=$EXTRACT(SRYN)
+2 IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to delete this surgical case from your records. If you have",!,"selected this option inadvertantly and do not want to remove this case,",!,"enter RETURN or 'NO'."
GOTO DEL
+3 IF "Yy"'[SRYN
SET SRSOUT=1
QUIT
+4 SET SRCC=""
SET SROPCOM="Operation..."
+5 IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)'=""
WRITE !!,"This case has been completed and must remain in the file for your records."
DO RET
QUIT
+6 IF $DATA(^SRF(SRTN,"LOCK"))
IF ^("LOCK")=1
WRITE !!,"This case has been verified and locked. It cannot be deleted unless unlocked",!,"by your Chief of Surgery, or someone appointed by him/her."
DO RET
QUIT
+7 IF $PIECE($GET(^SRF(SRTN,30)),"^")
SET SROPCAN=1
+8 IF $PIECE($GET(^SRF(SRTN,31)),"^",8)'=""
SET SROPCAN=1
+9 IF $DATA(SROPCAN)
WRITE !!,"This case has been cancelled and must remain in the file for your records."
DO RET
QUIT
+10 IF $PIECE($GET(^SRF(SRTN,31)),"^",4)
WRITE !!,"You cannot delete a procedure that has already been scheduled. If you",!,"would like to cancel this procedure, use the option 'Cancel Scheduled ",!,"Operation'."
DO RET
QUIT
+11 SET Y=$GET(^SRF(SRTN,"TIU"))
IF $PIECE(Y,"^")!$PIECE(Y,"^",2)!$PIECE(Y,"^",4)
WRITE !!,"You cannot delete a procedure that has one or more operative documents."
DO RET
QUIT
+12 ;checking associated transplant assessments
KILL ^TMP("SRTP",$JOB)
DO TP
IF SRSOUT=1
QUIT
KILL ; delete entry
+1 if '$$LOCK^SROUTL(SRTN)
QUIT
+2 SET SRCONC=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF SRCONC
KILL ^SRF(SRCONC,"CON")
+3 DO DEL^SROERR
+4 WRITE !!," Deleting "_SRCC_SROPCOM
IF $PIECE($GET(^SRF(SRTN,.2)),"^",10)
SET DIE=130
SET DA=SRTN
SET DR=".205///@"
DO ^DIE
KILL DA
+5 ; delete visit
SET SRX=$PIECE($GET(^SRF(SRTN,0)),"^",15)
IF SRX
SET SRVSIT=SRX
DO DEL^SROPCEP
+6 ; remove entry in file 136
IF $DATA(^SRO(136,SRTN,0))
SET DA=SRTN
SET DIK="^SRO(136,"
DO ^DIK
KILL DA,DIK
+7 SET (DA,SRTN1)=SRTN
SET DIK="^SRF("
DO ^DIK
DO UNLOCK^SROUTL(SRTN)
KILL DA,DIK,SRTN
+8 IF SRCONC
DO UNLOCK^SROUTL(SRCONC)
DO CON
IF SRCONC
DO KILL
+9 IF $DATA(^TMP("SRTP",$JOB))
DO KTP
+10 QUIT
CON ; delete concurrent case ?
+1 SET SRTN=SRCONC
WRITE !!,"There is a concurrent procedure associated with this case. Do you want to",!,"delete it also ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRCONC=0
QUIT
+2 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+3 ;SR207: check if case complete
IF $PIECE($GET(^SRF(SRTN,.2)),U,12)'=""
Begin DoDot:1
+4 WRITE !!,"The concurrent procedure associated with this case: ",SRCONC
+5 WRITE !,"has been completed and must remain in the file for your records."
+6 WRITE !!,"Press RETURN to continue "
READ X:DTIME
End DoDot:1
SET SRCONC=0
QUIT
+7 IF "YyNn"'[SRYN
WRITE !!,"Enter RETURN to delete this concurrent case. If you are not sure whether to",!,"delete the other case, enter 'NO'. It can be removed later if necessary."
GOTO CON
+8 IF "Nn"[SRYN
SET SRCONC=0
+9 QUIT
RET WRITE !!,"Press RETURN to continue "
READ X:DTIME
KILL SRTN
+1 QUIT
TP NEW SRATP,SRTPN,SRTPP
SET SRATP=0
+1 FOR
SET SRATP=$ORDER(^SRT("B",DFN,SRATP))
if 'SRATP
QUIT
SET SRTPN=$GET(^SRT(SRATP,0))
if $PIECE(SRTPN,"^",3)=SRTN
SET ^TMP("SRTP",$JOB,SRATP)=""
+2 if '$DATA(^TMP("SRTP",$JOB))
QUIT
+3 WRITE !!,"Deleting this case will also delete the transplant assessment(s) associated",!,"with this case. Are you sure you want to delete this case? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+4 if SRYN=""
SET SRYN="N"
SET SRYN=$EXTRACT(SRYN)
+5 IF "YyNn"'[SRYN
WRITE !!,"Enter YES to delete this case and its transplant assessment(s). Otherwise,",!,"enter NO."
GOTO TP
+6 IF "Yy"'[SRYN
SET SRSOUT=1
QUIT
+7 QUIT
KTP ; delete transplant assessments
+1 SET SRTPP=0
FOR
SET SRTPP=$ORDER(^TMP("SRTP",$JOB,SRTPP))
if 'SRTPP
QUIT
Begin DoDot:1
+2 KILL DA,DIK
SET DA=SRTPP
SET DIK="^SRT("
DO ^DIK
KILL DA,DIK
WRITE !!,"Deleting Transplant Assessment #",SRTPP
End DoDot:1
+3 KILL ^TMP("SRTP",$JOB)
+4 QUIT
