SRSCAN1 ;B'HAM ISC/MAM - CANCEL SCHEDULED OPERATION; 06/24/88 11:20
;;3.0; Surgery ;;24 Jun 93
S S(0)=^SRF(SRTN,0),S(31)=^SRF(SRTN,31),SRSDOC=$P(^SRF(SRTN,.1),"^",4),SRSDATE=$E($P(S(0),"^",9),1,7),SRSOR=$P(S(0),"^",2)
S SRSST=$P(S(31),"^",4),SRSET=$P(S(31),"^",5)
K SRSEDT S SRSDT1=SRSST,SRSDT2=SRSET,MM=$E(SRSET,1,7),XX=$P(SRSST,1,7) I MM>XX S SRSET1=SRSET,SRSEDT=MM
I '$D(SRSEDT) S SRSEDT=SRSDATE
S Y=SRSST D D^DIQ S SRFIND=$F(Y,":"),SRSST=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"00:00") S Y=SRSET D D^DIQ S SRFIND=$F(Y,":"),SRSET=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"")
W !!,"Reservation for "_$S(SRSOR="":"",'$D(^SRS(SRSOR,0)):"",$D(^SC($P(^(0),"^"),0)):$P(^(0),"^"),1:"")
W !,"Scheduled Start Time: "_$E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3)_" "_SRSST,!,"Scheduled End Time: "_$E(SRSEDT,4,5)_"-"_$E(SRSEDT,6,7)_"-"_$E(SRSEDT,2,3)_" "_SRSET
S SRSST=$P(SRSST,":")_"."_$P(SRSST,":",2),SRSET=$P(SRSET,":")_"."_$P(SRSET,":",2)
MM S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=VADM(1) W !,"Patient: "_SRNM
K SROPS,MM,MMM S SROPER=$P(^SRF(SRTN,"OP"),"^") S:$L(SROPER)<60 SROPS(1)=SROPER I $L(SROPER)>59 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
I SRSDOC S USER=$S($D(^VA(200,SRSDOC,0)):$P(^(0),"^"),1:"")
I SRSDOC="" S USER="NOT ENTERED"
W !,"Physician: "_USER
W !,"Procedure: "_SROPS(1) I $D(SROPS(2)) W !,?11,SROPS(2) I $D(SROPS(3)) W !,?11,SROPS(3) I $D(SROPS(4)) W !,?11,SROPS(4)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCAN1 1641 printed Nov 22, 2024@17:56:58 Page 2
SRSCAN1 ;B'HAM ISC/MAM - CANCEL SCHEDULED OPERATION; 06/24/88 11:20
+1 ;;3.0; Surgery ;;24 Jun 93
+2 SET S(0)=^SRF(SRTN,0)
SET S(31)=^SRF(SRTN,31)
SET SRSDOC=$PIECE(^SRF(SRTN,.1),"^",4)
SET SRSDATE=$EXTRACT($PIECE(S(0),"^",9),1,7)
SET SRSOR=$PIECE(S(0),"^",2)
+3 SET SRSST=$PIECE(S(31),"^",4)
SET SRSET=$PIECE(S(31),"^",5)
+4 KILL SRSEDT
SET SRSDT1=SRSST
SET SRSDT2=SRSET
SET MM=$EXTRACT(SRSET,1,7)
SET XX=$PIECE(SRSST,1,7)
IF MM>XX
SET SRSET1=SRSET
SET SRSEDT=MM
+5 IF '$DATA(SRSEDT)
SET SRSEDT=SRSDATE
+6 SET Y=SRSST
DO D^DIQ
SET SRFIND=$FIND(Y,":")
SET SRSST=$SELECT(SRFIND:$EXTRACT(Y,SRFIND-3,SRFIND+1),1:"00:00")
SET Y=SRSET
DO D^DIQ
SET SRFIND=$FIND(Y,":")
SET SRSET=$SELECT(SRFIND:$EXTRACT(Y,SRFIND-3,SRFIND+1),1:"")
+7 WRITE !!,"Reservation for "_$SELECT(SRSOR="":"",'$DATA(^SRS(SRSOR,0)):"",$DATA(^SC($PIECE(^(0),"^"),0)):$PIECE(^(0),"^"),1:"")
+8 WRITE !,"Scheduled Start Time: "_$EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_$EXTRACT(SRSDATE,2,3)_" "_SRSST,!,"Scheduled End Time: "_$EXTRACT(SRSEDT,4,5)_"-"_$EXTRACT(SRSEDT,6,7)_"-"_$EXTRACT(SRSEDT,2,3)_" "_SRSET
+9 SET SRSST=$PIECE(SRSST,":")_"."_$PIECE(SRSST,":",2)
SET SRSET=$PIECE(SRSET,":")_"."_$PIECE(SRSET,":",2)
MM SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO DEM^VADPT
SET SRNM=VADM(1)
WRITE !,"Patient: "_SRNM
+1 KILL SROPS,MM,MMM
SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
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 IF SRSDOC
SET USER=$SELECT($DATA(^VA(200,SRSDOC,0)):$PIECE(^(0),"^"),1:"")
+3 IF SRSDOC=""
SET USER="NOT ENTERED"
+4 WRITE !,"Physician: "_USER
+5 WRITE !,"Procedure: "_SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?11,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?11,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,?11,SROPS(4)
+6 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
