1 | SRSCHCC ;B'HAM ISC/MAM - DELETE CONCURRENT CASES ; [ 04/26/97 3:08 PM ]
|
---|
2 | ;;3.0; Surgery ;**3,67**;24 Jun 93
|
---|
3 | BEG W @IOF,!,"The following information has already been entered." S CON=0 F I=0:0 S CON=$O(SRSCON(CON)) Q:'CON D LIST^SRSCHDC
|
---|
4 | W !!!,"Since you have not entered all of the required operating room information, the",!,"schedule cannot be updated."
|
---|
5 | W !!,"You have the following options available to you at this point. One of these",!,"two options must be selected. Entering an '^' will not be accepted."
|
---|
6 | ASK W !!,"1. Create an Operation Request for the "_$S($D(SRSCON(2)):"Concurrent Cases",1:"Case"),!,"2. Delete the "_$S($D(SRSCON(2)):"Concurrent Cases",1:"Case")
|
---|
7 | W !!,"Select Number: 1// " R X:DTIME I '$T S X=2
|
---|
8 | S:X="" X=1 I X["^" G BEG
|
---|
9 | I X'=1,X'=2 D HELP G ASK
|
---|
10 | I X=2 D DEL Q
|
---|
11 | S CON=0 F I=0:0 S CON=$O(SRSCON(CON)) Q:'CON D REQ
|
---|
12 | Q
|
---|
13 | REQ ; make requests
|
---|
14 | S SRTN=SRSCON(CON),SRSOP=SRSCON(CON,"OP"),SRSDOC=SRSCON(CON,"DOC")
|
---|
15 | D NOW^%DTC S SRDT=$E(%,1,12)
|
---|
16 | K DIE,DR,DA S DIE=130,DR="36////1;Q;.09////"_SRSDATE_";1.099////"_DUZ_";1.098////"_SRDT,DA=SRTN D ^DIE
|
---|
17 | S SROERR=SRTN D ^SROERR0
|
---|
18 | Q
|
---|
19 | DEL W !!,"Are you sure you want to delete "_$S($D(SRSCON(2)):"these cases",1:"this case")_" ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="Y"
|
---|
20 | S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
|
---|
21 | I "YyNn"'[SRYN S SRTN=1 W !!,"Enter RETURN to delete the "_$S($D(SRSCON(2)):"entries",1:"entry")_" from your records."
|
---|
22 | I "Yy"'[SRYN S SRSOUT=0 Q
|
---|
23 | S CON=0 F S CON=$O(SRSCON(CON)) Q:'CON W !!," Deleting Case "_SRSCON(CON)_" ..." D OERR S DA=SRSCON(CON),DIK="^SRF(" D ^DIK K SRTN
|
---|
24 | Q
|
---|
25 | OERR ; delete from ORDER file (100)
|
---|
26 | N SRTN S SRTN=SRSCON(C0N) D DEL^SROERR
|
---|
27 | Q
|
---|
28 | HELP W !!,"If you want to make an operation request for the "_$S($D(SRSCON(2)):"cases",1:"case")_" entered, select '1'."
|
---|
29 | W !,"A request will be created for "_$S($D(SRSCON(2)):"both cases",1:"case "_SRSCON(1))_" on "_SRSDT_"."
|
---|
30 | W !!,"Select '2' if you want to REMOVE this record ENTIRELY from your records. "
|
---|
31 | Q
|
---|