| 1 | SROPDEL ;BIR/MAM - DELETE CASE ;06/14/05 | 
|---|
| 2 | ;;3.0; Surgery ;**67,100,142**;24 Jun 93 | 
|---|
| 3 | DEL W !!,"Are you sure that you want to delete this case ?  NO//  " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q | 
|---|
| 4 | S:SRYN="" SRYN="N" S SRYN=$E(SRYN) | 
|---|
| 5 | 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 | 
|---|
| 6 | I "Yy"'[SRYN S SRSOUT=1 Q | 
|---|
| 7 | S SRCC="",SROPCOM="Operation..." | 
|---|
| 8 | 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 | 
|---|
| 9 | 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." D RET Q | 
|---|
| 10 | I $P($G(^SRF(SRTN,30)),"^") S SROPCAN=1 | 
|---|
| 11 | I $P($G(^SRF(SRTN,31)),"^",8)'="" S SROPCAN=1 | 
|---|
| 12 | I $D(SROPCAN) W !!,"This case has been cancelled and must remain in the file for your records." D RET Q | 
|---|
| 13 | 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 | 
|---|
| 14 | 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 | 
|---|
| 15 | KILL ; delete entry | 
|---|
| 16 | Q:'$$LOCK^SROUTL(SRTN) | 
|---|
| 17 | S SRCONC=$P($G(^SRF(SRTN,"CON")),"^") I SRCONC K ^SRF(SRCONC,"CON") | 
|---|
| 18 | D DEL^SROERR | 
|---|
| 19 | W !!,"  Deleting "_SRCC_SROPCOM I $P($G(^SRF(SRTN,.2)),"^",10) S DIE=130,DA=SRTN,DR=".205///@" D ^DIE K DA | 
|---|
| 20 | S SRX=$P($G(^SRF(SRTN,0)),"^",15) I SRX S SRVSIT=SRX D DEL^SROPCEP ; delete visit | 
|---|
| 21 | I $D(^SRO(136,SRTN,0)) S DA=SRTN,DIK="^SRO(136," D ^DIK K DA,DIK ; remove entry in file 136 | 
|---|
| 22 | S (DA,SRTN1)=SRTN,DIK="^SRF(" D ^DIK,UNLOCK^SROUTL(SRTN) K DA,DIK,SRTN | 
|---|
| 23 | I SRCONC D UNLOCK^SROUTL(SRCONC),CON I SRCONC D KILL | 
|---|
| 24 | Q | 
|---|
| 25 | CON ; delete concurrent case ? | 
|---|
| 26 | 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 | 
|---|
| 27 | S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" | 
|---|
| 28 | 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 | 
|---|
| 29 | I "Nn"[SRYN S SRCONC=0 | 
|---|
| 30 | Q | 
|---|
| 31 | RET W !!,"Press RETURN to continue  " R X:DTIME K SRTN | 
|---|
| 32 | Q | 
|---|