source: WorldVistAEHR/trunk/r/SURGERY-SR/SROPDEL.m@ 1806

Last change on this file since 1806 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1SROPDEL ;BIR/MAM - DELETE CASE ;06/14/05
2 ;;3.0; Surgery ;**67,100,142**;24 Jun 93
3DEL 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
15KILL ; 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
25CON ; 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
31RET W !!,"Press RETURN to continue " R X:DTIME K SRTN
32 Q
Note: See TracBrowser for help on using the repository browser.