SRSCHCA.m

SRSCHCA ;B'HAM ISC/ADM - ADD CONCURRENT CASE TO ALREADY SCHEDULED CASE ; 26 MAY 1992  4:20 PM

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

 D ^SRSTCH I SRSOUT W !!,"No concurrent case has been added.",! S SRSOUT=0 G END

 S SRSCON=2,SRCC=1,SRSDATE=$P(^SRF(SRTN,0),"^",9),SRSOR=$P(^SRF(SRTN,0),"^",2),SRSDT1=$P(^(31),"^",4),SRSDT2=$P(^(31),"^",5)

 S Y=SRSDATE D D^DIQ S (SREQDT,SRSDT)=$E(Y,1,12)

 S SRSCON(1)=SRTN,SRSCON(1,"OP")=$P(^SRF(SRTN,"OP"),"^"),SRSCON(1,"DOC")=$P(^VA(200,$P(^SRF(SRTN,.1),"^",4),0),"^"),SRSCON(1,"SS")=$P(^SRO(137.45,$P(^SRF(SRTN,0),"^",4),0),"^")

 D CON^SRSCHUN I SRSOUT  W !!,"No concurrent case has been added.",! S SRSOUT=0 G END

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

DISP W @IOF,!,"The following cases have been entered."

 S CON=0 F  S CON=$O(SRSCON(CON)) Q:'CON  D LIST

 W !!!!,"1. Enter Information for Case #"_SRSCON(1),!,"2. Enter Information for Case #"_SRSCON(2),!

REQ K DIR S DIR("?")=" ",DIR("?",1)="Select the number corresponding to the case for which you want",DIR("?",2)="to enter information.  Enter '^' or RETURN to exit."

 S DIR(0)="NO^1:2",DIR("A")="Select Number" D ^DIR I Y=""!$D(DUOUT) S SRSOUT=1 G END

 S SRSCON=Y,(DA,SRTN)=SRSCON(SRSCON) I $$LOCK^SROUTL(SRTN) D SS^SRSCHUN1,UNLOCK^SROUTL(SRTN)

 G DISP

END I 'SRSOUT K DIR S DIR(0)="FOA",DIR("A")=" Press RETURN to continue. " D ^DIR

 K SRTN D ^SRSKILL W @IOF

 Q

LIST ; list stub info

 S SROPER=$P(^SRF(SRSCON(CON),"OP"),"^") 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=""

 W !!,CON_". ",?4,"Case # "_SRSCON(CON),?40,SRSDT,!,?4,"Surgeon: "_SRSCON(CON,"DOC"),?40,SRSCON(CON,"SS"),!,?4,"Procedure: ",?16,SROPS(1) I $D(SROPS(2)) W !,?16,SROPS(2) I $D(SROPS(3)) W !,?16,SROPS(3)

 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

SRSCHCA   ;B'HAM ISC/ADM - ADD CONCURRENT CASE TO ALREADY SCHEDULED CASE ; 26 MAY 1992  4:20 PM

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

 +2        DO ^SRSTCH

           IF SRSOUT

               WRITE !!,"No concurrent case has been added.",!

               SET SRSOUT=0

               GOTO END

 +3        SET SRSCON=2

           SET SRCC=1

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

           SET SRSOR=$PIECE(^SRF(SRTN,0),"^",2)

           SET SRSDT1=$PIECE(^(31),"^",4)

           SET SRSDT2=$PIECE(^(31),"^",5)

 +4        SET Y=SRSDATE

           DO D^DIQ

           SET (SREQDT,SRSDT)=$EXTRACT(Y,1,12)

 +5        SET SRSCON(1)=SRTN

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

           SET SRSCON(1,"DOC")=$PIECE(^VA(200,$PIECE(^SRF(SRTN,.1),"^",4),0),"^")

           SET SRSCON(1,"SS")=$PIECE(^SRO(137.45,$PIECE(^SRF(SRTN,0),"^",4),0),"^")

 +6        DO CON^SRSCHUN

           IF SRSOUT

               WRITE !!,"No concurrent case has been added.",!

               SET SRSOUT=0

               GOTO END

 +7        IF $$LOCK^SROUTL(SRTN)

               DO ^SRSCHUN1

               DO UNLOCK^SROUTL(SRTN)

DISP       WRITE @IOF,!,"The following cases have been entered."

 +1        SET CON=0

           FOR 

               SET CON=$ORDER(SRSCON(CON))

               IF 'CON

                   QUIT 

               DO LIST

 +2        WRITE !!!!,"1. Enter Information for Case #"_SRSCON(1),!,"2. Enter Information for Case #"_SRSCON(2),!

REQ        KILL DIR

           SET DIR("?")=" "

           SET DIR("?",1)="Select the number corresponding to the case for which you want"

           SET DIR("?",2)="to enter information.  Enter '^' or RETURN to exit."

 +1        SET DIR(0)="NO^1:2"

           SET DIR("A")="Select Number"

           DO ^DIR

           IF Y=""!$DATA(DUOUT)

               SET SRSOUT=1

               GOTO END

 +2        SET SRSCON=Y

           SET (DA,SRTN)=SRSCON(SRSCON)

           IF $$LOCK^SROUTL(SRTN)

               DO SS^SRSCHUN1

               DO UNLOCK^SROUTL(SRTN)

 +3        GOTO DISP

END        IF 'SRSOUT

               KILL DIR

               SET DIR(0)="FOA"

               SET DIR("A")=" Press RETURN to continue. "

               DO ^DIR

 +1        KILL SRTN

           DO ^SRSKILL

           WRITE @IOF

 +2        QUIT 

LIST      ; list stub info

 +1        SET SROPER=$PIECE(^SRF(SRSCON(CON),"OP"),"^")

           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 

 +2        WRITE !!,CON_". ",?4,"Case # "_SRSCON(CON),?40,SRSDT,!,?4,"Surgeon: "_SRSCON(CON,"DOC"),?40,SRSCON(CON,"SS"),!,?4,"Procedure: ",?16,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?16,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?16,SROPS(3)

 +3        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