- 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
