source: WorldVistAEHR/trunk/r/SURGERY-SR/SRSCHD1.m@ 792

Last change on this file since 792 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1SRSCHD1 ;B'HAM ISC/MAM - SCHEDULE REQUESTED OPERATIONS (CONT) ; [ 01/31/01 7:52 AM ]
2 ;;3.0; Surgery ;**37,100**;24 Jun 93
3REQ ; 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
6UN 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"),"^")
16SEL 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
22END ;
23 K SRTN D ^SRSKILL W @IOF
24 Q
25LOOP ; 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
Note: See TracBrowser for help on using the repository browser.