| [613] | 1 | SRSUPRQ ;B'HAM ISC/MAM - UPDATE REQUESTED OPERATIONS; [ 08/29/01 9:04 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**7,47,58,67,107,114,100,154**;24 Jun 93
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
|
|---|
| 5 | ;
|
|---|
| 6 | K SRSCHED
|
|---|
| 7 | 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),"^")
|
|---|
| 8 | 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
|
|---|
| 9 | I '$D(SRCASE(1)) W !!,"There are no requested cases for "_SRNM_"." G END
|
|---|
| 10 | S GRAMMER=$S($D(SRCASE(2)):"cases are",1:"case is") W @IOF,!,"The following "_GRAMMER_" requested for "_SRNM_":",!
|
|---|
| 11 | 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)
|
|---|
| 12 | OPT S SREQ=1 I $D(SRCASE(2)) D MANY
|
|---|
| 13 | 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
|
|---|
| 14 | Q:$D(SRSCHED) G:'$D(SRTN) END W !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date"
|
|---|
| 15 | SEL W !!,"Select Number: " R Z:DTIME S:'$T!("^"[Z) SRSOUT=1 G:SRSOUT END S:Z["?" Z=4
|
|---|
| 16 | 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
|
|---|
| 17 | I $D(^XTMP("SRLOCK-"_SRTN)) D MSG G END
|
|---|
| 18 | I Z=1 D DEL G END
|
|---|
| 19 | I Z=2 D UPDATE S SRSOUT=1 G END
|
|---|
| 20 | I Z=3 D CHANGE^SRSDT
|
|---|
| 21 | END I '$D(SRLATE) S SRLATE=0
|
|---|
| 22 | I 'SRLATE,'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 23 | W @IOF D ^SRSKILL K SRTN,SRTN1,SRTNX
|
|---|
| 24 | Q
|
|---|
| 25 | 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=""
|
|---|
| 26 | Q
|
|---|
| 27 | LOOP ; break procedure if greater than 60 characters
|
|---|
| 28 | 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
|
|---|
| 29 | Q
|
|---|
| 30 | MANY ; select requested case if more than one
|
|---|
| 31 | 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
|
|---|
| 32 | S SRTN=$P(SRCASE(SREQ),"^")
|
|---|
| 33 | Q
|
|---|
| 34 | SETUP ; set SRCASE array to list requested cases for this patient
|
|---|
| 35 | 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"),"^")
|
|---|
| 36 | Q
|
|---|
| 37 | DEL ; delete request
|
|---|
| 38 | 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
|
|---|
| 39 | S X=$E(X) Q:"Yy"'[X I '$$LOCK^SROUTL(SRTN) Q
|
|---|
| 40 | 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)
|
|---|
| 41 | S SRCON=$P($G(^SRF(SRTN,"CON")),"^") I SRCON D CON I SRBOTH="^" G END
|
|---|
| 42 | OPALSO ; delete from file 130
|
|---|
| 43 | S SROPCOM="Operation ..."
|
|---|
| 44 | 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)
|
|---|
| 45 | Q
|
|---|
| 46 | 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)
|
|---|
| 47 | Q
|
|---|
| 48 | CC ; check to see if concurrent case should be deleted
|
|---|
| 49 | 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
|
|---|
| 50 | S:SRBOTH="" SRBOTH="Y" S SRBOTH=$E(SRBOTH) I "YyNn"'[SRBOTH W !!,"Enter RETURN if you want these case to remain concurrent." G CC
|
|---|
| 51 | I SRBOTH["Y" S SRBOTH=1
|
|---|
| 52 | S DA=SRCON,DR="35///@",DIE=130 D ^DIE S SROERR=SRCON D ^SROERR0 S DA=SRTN,DR="35///@",DIE=130 D ^DIE
|
|---|
| 53 | I SRBOTH'=1 K SRCON
|
|---|
| 54 | Q
|
|---|
| 55 | UPDATE ; update requested operation
|
|---|
| 56 | N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) Q:'SRLCK
|
|---|
| 57 | D AVG^SRSREQ D RT K SRLNTH,SRLNTH1,DR,X
|
|---|
| 58 | S ST="UPDATE REQUEST",DA=SRTN,DIE=130,DR="[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)=""
|
|---|
| 59 | K DR D:$D(SRODR) ^SROCON1 D RISK^SROAUTL3,^SROPCE1
|
|---|
| 60 | S SROERR=SRTN K SRTX D ^SROERR0
|
|---|
| 61 | I $G(SRLCK) D UNLOCK^SROUTL(SRTN)
|
|---|
| 62 | Q
|
|---|
| 63 | RT ; start RT logging
|
|---|
| 64 | I $D(XRTL) S XRTN="SRSUPRQ" D T0^%ZOSV
|
|---|
| 65 | Q
|
|---|
| 66 | MSG W !!,"This case is currently being edited.",!,"Please try again later...",!! Q
|
|---|
