- 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
