SRSCHD1.m

SRSCHD1 ;B'HAM ISC/MAM - SCHEDULE REQUESTED OPERATIONS (CONT) ; [ 01/31/01  7:52 AM ]

 ;;3.0; Surgery ;**37,100**;24 Jun 93

REQ ; select request

 K SRCASE,SRTN W ! S SRSCHED=1 D ASK^SRSUPRQ G:'$D(SRTN) END

 I $D(^DPT(SRDFN,.35)),$P(^(.35),"^")'="" S Y=$E($P(^(.35),"^"),1,7) D D^DIQ W !!,"The records show that "_SRNM_" died on "_Y_".",!!,"Press RETURN to continue  " R X:DTIME G END

UN S DFN=SRDFN,SRSOP=$P(^SRF(SRTN,"OP"),"^")

 S SRSDOC=$P($G(^SRF(SRTN,.1)),"^",4)

 S SROPER=SRSOP K SROPS,MM,MMM S:$L(SROPER)<75 SROPS(1)=SROPER I $L(SROPER)>74 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 W !!!,"Case Information: ",!,SROPS(1) I $D(SROPS(2)) W !,SROPS(2) I $D(SROPS(3)) W !,SROPS(3)

 W !,"By " S USER=$S(SRSDOC:$P(^VA(200,SRSDOC,0),"^"),1:"NOT ENTERED") W USER D DEM^VADPT W ?40,"On "_VADM(1),!,"Case # "_SRTN

 S HOURS=$P($G(^SRF(SRTN,.4)),"^") I HOURS W ?40,"For "_HOURS_" Hours"

 S Z=$P(^SRF(SRTN,0),"^",10) I Z'="" S SRSTYP=$S(Z="EL":"ELECTIVE",Z="EM":"EMERGENCY",Z="A":"ADD ON TODAY (NONEMERGENT)",Z="S":"STANDBY",Z="U":"URGENT ADD ON TODAY",1:"")

 W !,$S($D(SRSTYP):SRSTYP,1:""),?40,$P(^SRF(SRTN,0),"^",11)

 W !!,"Comments:" S COMMENT=0 F  S COMMENT=$O(^SRF(SRTN,5,COMMENT)) Q:'COMMENT  W !,^SRF(SRTN,5,COMMENT,0)

 I $D(^SRF(SRTN,"CON")),$P(^("CON"),"^") S SRCON=$P(^("CON"),"^") W !!,"  * Concurrent Case # "_SRCON_"  "_$P(^SRF(SRCON,"OP"),"^")

SEL W !!,"Is this the correct operation ?  YES//  " R SRYN:DTIME S:'$T SRYN="^" G:SRYN["^" END S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"

 I "NnYn"'[SRYN W !!,"Enter 'NO' if you have selected the wrong request, or RETURN to continue",!,"scheduling this request. ",! G SEL

 I "Yy"'[SRYN G END

 K NOWAY D ^SRSCHK I $D(NOWAY) G END

 I $$LOCK^SROUTL(SRTN) D ^SRSCHD2,UNLOCK^SROUTL(SRTN)

 G REQ

END ;

 K SRTN D ^SRSKILL W @IOF

 Q

LOOP ; break procedure if greater than 75 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)'<75  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM

 Q

SRSCHD1   ;B'HAM ISC/MAM - SCHEDULE REQUESTED OPERATIONS (CONT) ; [ 01/31/01  7:52 AM ]

 +1       ;;3.0; Surgery ;**37,100**;24 Jun 93

REQ       ; select request

 +1        KILL SRCASE,SRTN

           WRITE !

           SET SRSCHED=1

           DO ASK^SRSUPRQ

           IF '$DATA(SRTN)

               GOTO END

 +2        IF $DATA(^DPT(SRDFN,.35))

               IF $PIECE(^(.35),"^")'=""

                   SET Y=$EXTRACT($PIECE(^(.35),"^"),1,7)

                   DO D^DIQ

                   WRITE !!,"The records show that "_SRNM_" died on "_Y_".",!!,"Press RETURN to continue  "

                   READ X:DTIME

                   GOTO END

UN         SET DFN=SRDFN

           SET SRSOP=$PIECE(^SRF(SRTN,"OP"),"^")

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

 +2        SET SROPER=SRSOP

           KILL SROPS,MM,MMM

           IF $LENGTH(SROPER)<75

               SET SROPS(1)=SROPER

           IF $LENGTH(SROPER)>74

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT 

 +3        WRITE !!!,"Case Information: ",!,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,SROPS(3)

 +4        WRITE !,"By "

           SET USER=$SELECT(SRSDOC:$PIECE(^VA(200,SRSDOC,0),"^"),1:"NOT ENTERED")

           WRITE USER

           DO DEM^VADPT

           WRITE ?40,"On "_VADM(1),!,"Case # "_SRTN

 +5        SET HOURS=$PIECE($GET(^SRF(SRTN,.4)),"^")

           IF HOURS

               WRITE ?40,"For "_HOURS_" Hours"

 +6        SET Z=$PIECE(^SRF(SRTN,0),"^",10)

           IF Z'=""

               SET SRSTYP=$SELECT(Z="EL":"ELECTIVE",Z="EM":"EMERGENCY",Z="A":"ADD ON TODAY (NONEMERGENT)",Z="S":"STANDBY",Z="U":"URGENT ADD ON TODAY",1:"")

 +7        WRITE !,$SELECT($DATA(SRSTYP):SRSTYP,1:""),?40,$PIECE(^SRF(SRTN,0),"^",11)

 +8        WRITE !!,"Comments:"

           SET COMMENT=0

           FOR 

               SET COMMENT=$ORDER(^SRF(SRTN,5,COMMENT))

               IF 'COMMENT

                   QUIT 

               WRITE !,^SRF(SRTN,5,COMMENT,0)

 +9        IF $DATA(^SRF(SRTN,"CON"))

               IF $PIECE(^("CON"),"^")

                   SET SRCON=$PIECE(^("CON"),"^")

                   WRITE !!,"  * Concurrent Case # "_SRCON_"  "_$PIECE(^SRF(SRCON,"OP"),"^")

SEL        WRITE !!,"Is this the correct operation ?  YES//  "

           READ SRYN:DTIME

           IF '$TEST

               SET SRYN="^"

           IF SRYN["^"

               GOTO END

           SET SRYN=$EXTRACT(SRYN)

           IF SRYN=""

               SET SRYN="Y"

 +1        IF "NnYn"'[SRYN

               WRITE !!,"Enter 'NO' if you have selected the wrong request, or RETURN to continue",!,"scheduling this request. ",!

               GOTO SEL

 +2        IF "Yy"'[SRYN

               GOTO END

 +3        KILL NOWAY

           DO ^SRSCHK

           IF $DATA(NOWAY)

               GOTO END

 +4        IF $$LOCK^SROUTL(SRTN)

               DO ^SRSCHD2

               DO UNLOCK^SROUTL(SRTN)

 +5        GOTO REQ

END       ;

 +1        KILL SRTN

           DO ^SRSKILL

           WRITE @IOF

 +2        QUIT 

LOOP      ; break procedure if greater than 75 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)'<75

                   QUIT 

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

               SET SROPER=MMM

 +2        QUIT