source: WorldVistAEHR/trunk/r/SURGERY-SR/SRSUPRQ.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1SRSUPRQ ;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
7ASK 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)
12OPT 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"
15SEL 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
21END 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
25OPS 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
27LOOP ; 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
30MANY ; 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
34SETUP ; 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
37DEL ; 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
42OPALSO ; 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
46CON 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
48CC ; 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
55UPDATE ; 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
63RT ; start RT logging
64 I $D(XRTL) S XRTN="SRSUPRQ" D T0^%ZOSV
65 Q
66MSG W !!,"This case is currently being edited.",!,"Please try again later...",!! Q
Note: See TracBrowser for help on using the repository browser.