SRSUPRQ.m

SRSUPRQ ;B'HAM ISC/MAM - UPDATE REQUESTED OPERATIONS; [ 08/29/01  9:04 AM ]

 ;;3.0; Surgery ;**7,47,58,67,107,114,100,154**;24 Jun 93

 ;

 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498

 ;

 K SRSCHED

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),"^")

 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

 I '$D(SRCASE(1)) W !!,"There are no requested cases for "_SRNM_"." G END

 S GRAMMER=$S($D(SRCASE(2)):"cases are",1:"case is") W @IOF,!,"The following "_GRAMMER_" requested for "_SRNM_":",!

 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)

OPT S SREQ=1 I $D(SRCASE(2)) D MANY

 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

 Q:$D(SRSCHED)  G:'$D(SRTN) END W !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date"

SEL W !!,"Select Number: " R Z:DTIME S:'$T!("^"[Z) SRSOUT=1 G:SRSOUT END S:Z["?" Z=4

 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

 I $D(^XTMP("SRLOCK-"_SRTN)) D MSG G END

 I Z=1 D DEL G END

 I Z=2 D UPDATE S SRSOUT=1 G END

 I Z=3 D CHANGE^SRSDT

END I '$D(SRLATE) S SRLATE=0

 I 'SRLATE,'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 W @IOF D ^SRSKILL K SRTN,SRTN1,SRTNX

 Q

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=""

 Q

LOOP ; break procedure if greater than 60 characters

 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

 Q

MANY ; select requested case if more than one

 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

 S SRTN=$P(SRCASE(SREQ),"^")

 Q

SETUP ; set SRCASE array to list requested cases for this patient

 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"),"^")

 Q

DEL ; delete request

 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

 S X=$E(X) Q:"Yy"'[X  I '$$LOCK^SROUTL(SRTN) Q

 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)

 S SRCON=$P($G(^SRF(SRTN,"CON")),"^") I SRCON D CON I SRBOTH="^" G END

OPALSO ; delete from file 130

 S SROPCOM="Operation ..."

 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)

 Q

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)

 Q

CC ; check to see if concurrent case should be deleted

 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

 S:SRBOTH="" SRBOTH="Y" S SRBOTH=$E(SRBOTH) I "YyNn"'[SRBOTH W !!,"Enter RETURN if you want these case to remain concurrent." G CC

 I SRBOTH["Y" S SRBOTH=1

 S DA=SRCON,DR="35///@",DIE=130 D ^DIE S SROERR=SRCON D ^SROERR0 S DA=SRTN,DR="35///@",DIE=130 D ^DIE

 I SRBOTH'=1 K SRCON

 Q

UPDATE ; update requested operation

 N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) Q:'SRLCK

 D AVG^SRSREQ D RT K SRLNTH,SRLNTH1,DR,X

 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)=""

 K DR D:$D(SRODR) ^SROCON1 D RISK^SROAUTL3,^SROPCE1

 S SROERR=SRTN K SRTX D ^SROERR0

 I $G(SRLCK) D UNLOCK^SROUTL(SRTN)

 Q

RT ; start RT logging

 I $D(XRTL) S XRTN="SRSUPRQ" D T0^%ZOSV

 Q

MSG W !!,"This case is currently being edited.",!,"Please try again later...",!! Q

SRSUPRQ   ;B'HAM ISC/MAM - UPDATE REQUESTED OPERATIONS; [ 08/29/01  9:04 AM ]

 +1       ;;3.0; Surgery ;**7,47,58,67,107,114,100,154**;24 Jun 93

 +2       ;

 +3       ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498

 +4       ;

 +5        KILL SRSCHED

ASK        KILL DIC,SRCASE

           SET SRSOUT=0

           SET DIC=2

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select Patient: "

           DO ^DIC

           KILL DIC

           IF Y<0

               QUIT 

           SET SRDFN=+Y

           SET SRNM=$PIECE(Y(0),"^")

 +1        SET (CNT,SRSDATE,SRTN)=0

           FOR 

               SET SRSDATE=$ORDER(^SRF("AR",SRSDATE))

               IF 'SRSDATE

                   QUIT 

               FOR 

                   SET SRTN=$ORDER(^SRF("AR",SRSDATE,SRDFN,SRTN))

                   IF 'SRTN

                       QUIT 

                   DO SETUP

 +2        IF '$DATA(SRCASE(1))

               WRITE !!,"There are no requested cases for "_SRNM_"."

               GOTO END

 +3        SET GRAMMER=$SELECT($DATA(SRCASE(2)):"cases are",1:"case is")

           WRITE @IOF,!,"The following "_GRAMMER_" requested for "_SRNM_":",!

 +4        SET CNT=0

           FOR 

               SET CNT=$ORDER(SRCASE(CNT))

               IF 'CNT

                   QUIT 

               DO OPS

               WRITE !,$PIECE(SRCASE(CNT),"^",2),?15,SROPS(1)

               IF $DATA(SROPS(2))

                   WRITE !,?15,SROPS(2)

                   IF $DATA(SROPS(3))

                       WRITE !,?15,SROPS(3)

OPT        SET SREQ=1

           IF $DATA(SRCASE(2))

               DO MANY

 +1        IF "^"[SREQ

               GOTO END

           IF '$DATA(SRCASE(2))

               SET SRTN=$PIECE(SRCASE(1),"^")

           SET SRSDATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)

           IF $PIECE(^SRF(SRTN,0),"^",4)=""

               DO SS^SRSCHUP

               IF SRSOUT

                   KILL SRTN

 +2        IF $DATA(SRSCHED)

               QUIT 

           IF '$DATA(SRTN)

               GOTO END

           WRITE !!,"1. Delete",!,"2. Update Request Information",!,"3. Change the Request Date"

SEL        WRITE !!,"Select Number: "

           READ Z:DTIME

           IF '$TEST!("^"[Z)

               SET SRSOUT=1

           IF SRSOUT

               GOTO END

           IF Z["?"

               SET Z=4

 +1        IF Z<1!(Z>3)!(+Z\1'=Z)

               WRITE !!,"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."

               GOTO SEL

 +2        IF $DATA(^XTMP("SRLOCK-"_SRTN))

               DO MSG

               GOTO END

 +3        IF Z=1

               DO DEL

               GOTO END

 +4        IF Z=2

               DO UPDATE

               SET SRSOUT=1

               GOTO END

 +5        IF Z=3

               DO CHANGE^SRSDT

END        IF '$DATA(SRLATE)

               SET SRLATE=0

 +1        IF 'SRLATE

               IF 'SRSOUT

                   WRITE !!,"Press RETURN to continue  "

                   READ X:DTIME

 +2        WRITE @IOF

           DO ^SRSKILL

           KILL SRTN,SRTN1,SRTNX

 +3        QUIT 

OPS        SET SROPER=$PIECE(SRCASE(CNT),"^",3)

           KILL SROPS,MM,MMM

           IF $LENGTH(SROPER)<60

               SET SROPS(1)=SROPER

           IF $LENGTH(SROPER)>59

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT 

 +1        QUIT 

LOOP      ; break procedure if greater than 60 characters

 +1        SET SROPS(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

               SET MMM=$PIECE(SROPER," ",2,200)

               IF MMM=""

                   QUIT 

               IF $LENGTH(SROPS(M))+$LENGTH(MM)'<60

                   QUIT 

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT 

MANY      ; select requested case if more than one

 +1        WRITE !!,"Select Operation Request: "

           READ SREQ:DTIME

           IF '$TEST

               SET SREQ="^"

           IF "^"[SREQ

               QUIT 

           IF SREQ["?"!'$DATA(SRCASE(SREQ))

               WRITE !!,"Enter the number corresponding to the request that will be updated or deleted. "

               GOTO MANY

 +2        SET SRTN=$PIECE(SRCASE(SREQ),"^")

 +3        QUIT 

SETUP     ; set SRCASE array to list requested cases for this patient

 +1        SET CNT=CNT+1

           SET SRSDT=$PIECE(^SRF(SRTN,0),"^",9)

           SET SRSDT=$EXTRACT(SRSDT,4,5)_"-"_$EXTRACT(SRSDT,6,7)_"-"_$EXTRACT(SRSDT,2,3)

           SET SRCASE(CNT)=SRTN_"^"_CNT_".  "_SRSDT_"^"_$PIECE(^SRF(SRTN,"OP"),"^")

 +2        QUIT 

DEL       ; delete request

 +1        SET SRBOTH=0

           WRITE !!,"Are you sure that you want to delete this request ?  YES// "

           READ X:DTIME

           IF '$TEST

               SET X="N"

           IF X=""

               SET X="Y"

           IF X["?"

               WRITE !!,"Enter RETURN if this request is to be deleted, or NO to quit. "

               GOTO DEL

 +2        SET X=$EXTRACT(X)

           IF "Yy"'[X

               QUIT 

           IF '$$LOCK^SROUTL(SRTN)

               QUIT 

 +3        KILL DIE,DR,DA

           SET DA=SRTN

           SET DIE=130

           SET DR="36///0;Q;.09///"_SRSDATE

           DO ^DIE

           KILL DR,DA,DIE

           SET SRSDOC=$PIECE(^SRF(SRTN,.1),"^",4)

 +4        SET SRCON=$PIECE($GET(^SRF(SRTN,"CON")),"^")

           IF SRCON

               DO CON

               IF SRBOTH="^"

                   GOTO END

OPALSO    ; delete from file 130

 +1        SET SROPCOM="Operation ..."

 +2        SET DFN=SRDFN

           SET SRCC=""

           SET SRTNX=SRTN

           DO KILL^SROPDEL

           DO UNLOCK^SROUTL(SRTNX)

           SET SRTN=SRTN1

           IF $DATA(SRCON)

               SET SRC=""

               IF "^"[SRBOTH

                   GOTO END

               IF SRBOTH=1

                   SET SRTN=SRCON

                   SET SRCC="Concurrent "

                   DO KILL^SROPDEL

                   DO UNLOCK^SROUTL(SRCON)

 +3        QUIT 

CON        SET SRCON=^SRF(SRTN,"CON")

           SET SRC="the request for"

           DO CC

           IF SRBOTH="^"

               QUIT 

           IF SRBOTH=1

               KILL DIE,DR,DA

               SET DA=SRCON

               SET DIE=130

               SET DR="36///0;Q;.09///"_SRSDATE

               DO ^DIE

               KILL DR,DIE,DA

               SET SRSDOCC=$PIECE(^SRF(SRCON,.1),"^",4)

 +1        QUIT 

CC        ; check to see if concurrent case should be deleted

 +1        WRITE !!,"A concurrent case has been requested for this operation.  Do you want to",!,"delete "_SRC_" it also ?  YES// "

           READ SRBOTH:DTIME

           IF '$TEST

               SET SRBOTH="^"

           IF SRBOTH["?"

               WRITE !!,"Enter 'Y' if you want to delete "_SRC_" concurrent case."

               GOTO CC

 +2        IF SRBOTH=""

               SET SRBOTH="Y"

           SET SRBOTH=$EXTRACT(SRBOTH)

           IF "YyNn"'[SRBOTH

               WRITE !!,"Enter RETURN if you want these case to remain concurrent."

               GOTO CC

 +3        IF SRBOTH["Y"

               SET SRBOTH=1

 +4        SET DA=SRCON

           SET DR="35///@"

           SET DIE=130

           DO ^DIE

           SET SROERR=SRCON

           DO ^SROERR0

           SET DA=SRTN

           SET DR="35///@"

           SET DIE=130

           DO ^DIE

 +5        IF SRBOTH'=1

               KILL SRCON

 +6        QUIT 

UPDATE    ; update requested operation

 +1        NEW SRLCK

           SET SRLCK=$$LOCK^SROUTL(SRTN)

           IF 'SRLCK

               QUIT 

 +2        DO AVG^SRSREQ

           DO RT

           KILL SRLNTH,SRLNTH1,DR,X

 +3        SET ST="UPDATE REQUEST"

           SET DA=SRTN

           SET DIE=130

           SET DR="[SRSRES-ENTRY]"

           DO EN2^SROVAR

           KILL Q3("VIEW"),Y

           SET SPD=$$CHKS^SRSCOR(SRTN)

           DO ^SRCUSS

           IF SPD'=$$CHKS^SRSCOR(SRTN)

               SET ^TMP("CSLSUR1",$JOB)=""

 +4        KILL DR

           IF $DATA(SRODR)

               DO ^SROCON1

           DO RISK^SROAUTL3

           DO ^SROPCE1

 +5        SET SROERR=SRTN

           KILL SRTX

           DO ^SROERR0

 +6        IF $GET(SRLCK)

               DO UNLOCK^SROUTL(SRTN)

 +7        QUIT 

RT        ; start RT logging

 +1        IF $DATA(XRTL)

               SET XRTN="SRSUPRQ"

               DO T0^%ZOSV

 +2        QUIT 

MSG        WRITE !!,"This case is currently being edited.",!,"Please try again later...",!!

           QUIT