| 1 | SRSCHD1 ;B'HAM ISC/MAM - SCHEDULE REQUESTED OPERATIONS (CONT) ; [ 01/31/01  7:52 AM ]
 | 
|---|
| 2 |  ;;3.0; Surgery ;**37,100**;24 Jun 93
 | 
|---|
| 3 | REQ ; select request
 | 
|---|
| 4 |  K SRCASE,SRTN W ! S SRSCHED=1 D ASK^SRSUPRQ G:'$D(SRTN) END
 | 
|---|
| 5 |  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
 | 
|---|
| 6 | UN S DFN=SRDFN,SRSOP=$P(^SRF(SRTN,"OP"),"^")
 | 
|---|
| 7 |  S SRSDOC=$P($G(^SRF(SRTN,.1)),"^",4)
 | 
|---|
| 8 |  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=""
 | 
|---|
| 9 |  W !!!,"Case Information: ",!,SROPS(1) I $D(SROPS(2)) W !,SROPS(2) I $D(SROPS(3)) W !,SROPS(3)
 | 
|---|
| 10 |  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
 | 
|---|
| 11 |  S HOURS=$P($G(^SRF(SRTN,.4)),"^") I HOURS W ?40,"For "_HOURS_" Hours"
 | 
|---|
| 12 |  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:"")
 | 
|---|
| 13 |  W !,$S($D(SRSTYP):SRSTYP,1:""),?40,$P(^SRF(SRTN,0),"^",11)
 | 
|---|
| 14 |  W !!,"Comments:" S COMMENT=0 F  S COMMENT=$O(^SRF(SRTN,5,COMMENT)) Q:'COMMENT  W !,^SRF(SRTN,5,COMMENT,0)
 | 
|---|
| 15 |  I $D(^SRF(SRTN,"CON")),$P(^("CON"),"^") S SRCON=$P(^("CON"),"^") W !!,"  * Concurrent Case # "_SRCON_"  "_$P(^SRF(SRCON,"OP"),"^")
 | 
|---|
| 16 | 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"
 | 
|---|
| 17 |  I "NnYn"'[SRYN W !!,"Enter 'NO' if you have selected the wrong request, or RETURN to continue",!,"scheduling this request. ",! G SEL
 | 
|---|
| 18 |  I "Yy"'[SRYN G END
 | 
|---|
| 19 |  K NOWAY D ^SRSCHK I $D(NOWAY) G END
 | 
|---|
| 20 |  I $$LOCK^SROUTL(SRTN) D ^SRSCHD2,UNLOCK^SROUTL(SRTN)
 | 
|---|
| 21 |  G REQ
 | 
|---|
| 22 | END ;
 | 
|---|
| 23 |  K SRTN D ^SRSKILL W @IOF
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 | LOOP ; break procedure if greater than 75 characters
 | 
|---|
| 26 |  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
 | 
|---|
| 27 |  Q
 | 
|---|