SROREQ4 ;BIR/MAM - OPERATION REQUESTS (SHORT) ; [ 12/09/99 11:54 AM ]
;;3.0; Surgery ;**26,48,92,161**;24 Jun 93;Build 5
BEG ; entry when queued
K ^TMP("SR",$J) U IO S (CNT,DFN,SRSOUT)=0
S Y=SRSDATE,SRDT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) D D^DIQ S SRSDT=$E(Y,1,12)
F S DFN=$O(^SRF("AR",SRSDATE,DFN)) Q:'DFN S SRTN=0 F S SRTN=$O(^SRF("AR",SRSDATE,DFN,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D SET
W:$Y @IOF S SRSNM=0 F S SRSNM=$O(^TMP("SR",$J,SRSNM)) Q:SRSNM=""!(SRSOUT) D HDR S (SREQDT,CNT)=0 F S SREQDT=$O(^TMP("SR",$J,SRSNM,SREQDT)) Q:SREQDT=""!(SRSOUT) D MORE
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
S:$E(IOST)="P" SRSOUT=1 I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
D ^%ZISC K SRTN D ^SRSKILL W @IOF
Q
MORE ; continue looping
S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SRSNM,SREQDT,SRTN)) Q:'SRTN!(SRSOUT) D PRINT
Q
SET ; set ^TMP(
S SRSS=$P(^SRF(SRTN,0),"^",4),SRSNM=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"ZZ")
S SREQDT=$P($G(^SRF(SRTN,"1.0")),"^",11) S:'SREQDT SREQDT="ZZ"
S ^TMP("SR",$J,SRSNM,SREQDT,SRTN)=""
Q
PRINT ; print from ^TMP("SR",$J)
I $Y+7>IOSL D PAGE I SRSOUT Q
S S(0)=$G(^SRF(SRTN,0)) Q:'S(0) ; << RJS *161
S DFN=$P(S(0),"^"),CNT=CNT+1
D DEM^VADPT S SRNAME=VADM(1),SROPER=$P(^SRF(SRTN,"OP"),"^"),SRSUR=$P($G(^SRF(SRTN,.1)),"^",4),SRSUR=$S(SRSUR:$P(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED")
S SRHRS=$P($G(^SRF(SRTN,.4)),"^"),SRD=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)
S:SRHRS="" SRHRS="NOT ENTERED" S C=$P(^DD(130,.035,0),"^",2),Y=$P(S(0),"^",10) D:Y'="" Y^DIQ S SRTYPE=Y,SRANES=$P($G(^SRF(SRTN,"1.0")),"^"),Y=SRANES,C=$P(^DD(130,1.01,0),"^",2) D:Y'="" Y^DIQ S SRANES=Y
S SRSORD=$P(S(0),"^",11),SSN=VA("PID"),SRWARD=$S($D(^DPT(DFN,.1)):^(.1),1:"") I SRTYPE'="" S SRTYPE=" ("_$P(SRTYPE,"(")_")"
K SROPS,MM,MMM S SROPER=SROPER_SRTYPE S:$L(SROPER)<63 SROPS(1)=SROPER I $L(SROPER)>62 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
W !!,CNT_".",?5,"Case Number: "_SRTN,?40,"Operation Date: "_SRD,!,?5,"Patient: ",?14,SRNAME,?40,"Ward: ",SRWARD,!,?5,"ID#: ",?14,VA("PID"),?40,"Surgeon: "_SRSUR,!,?5,"Procedure: "_SROPS(1)
I $D(SROPS(2)) W !,?16,SROPS(2) I $D(SROPS(3)) W !,?16,SROPS(3) I $D(SROPS(4)) W !,?16,SROPS(4)
W !,?5,"Estimated Case Length: "_SRHRS W:SRSORD'="" !,?5,"Case Schedule Order: "_SRSORD W:SRANES'="" !,?5,"Requested Anesthesia: "_SRANES
K SRSCON I $D(^SRF(SRTN,"CON")),$P(^("CON"),"^") S SRSCON=$P(^("CON"),"^") K A S SROPER=$P(^SRF(SRSCON,"OP"),"^") S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MM=""
I $D(SRSCON) W !,"Concurrent Case # "_SRSCON,!,SROPS(1) I $D(SROPS(2)) W !,SROPS(2) I $D(SROPS(3)) W !,SROPS(3)
Q
PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I X["^" S SRSOUT=1 Q
W:$Y @IOF
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
I $Y+4>IOSL D PAGE Q
W !! F LINE=1:1:80 W "="
W !,"REQUESTS FOR "_$S(SRSNM'="ZZ":SRSNM,1:"UNKNOWN"),?70,SRDT,! F LINE=1:1:80 W "-"
Q
LOOP ; break procedure if greater than 63 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)'<63 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROREQ4 3274 printed Oct 16, 2024@18:46:27 Page 2
SROREQ4 ;BIR/MAM - OPERATION REQUESTS (SHORT) ; [ 12/09/99 11:54 AM ]
+1 ;;3.0; Surgery ;**26,48,92,161**;24 Jun 93;Build 5
BEG ; entry when queued
+1 KILL ^TMP("SR",$JOB)
USE IO
SET (CNT,DFN,SRSOUT)=0
+2 SET Y=SRSDATE
SET SRDT=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
DO D^DIQ
SET SRSDT=$EXTRACT(Y,1,12)
+3 FOR
SET DFN=$ORDER(^SRF("AR",SRSDATE,DFN))
if 'DFN
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AR",SRSDATE,DFN,SRTN))
if 'SRTN
QUIT
IF $DATA(^SRF(SRTN,0))
IF $$DIV^SROUTL0(SRTN)
DO SET
+4 if $Y
WRITE @IOF
SET SRSNM=0
FOR
SET SRSNM=$ORDER(^TMP("SR",$JOB,SRSNM))
if SRSNM=""!(SRSOUT)
QUIT
DO HDR
SET (SREQDT,CNT)=0
FOR
SET SREQDT=$ORDER(^TMP("SR",$JOB,SRSNM,SREQDT))
if SREQDT=""!(SRSOUT)
QUIT
DO MORE
END if $EXTRACT(IOST)="P"
WRITE @IOF
IF $DATA(ZTQUEUED)
KILL ^TMP("SR",$JOB)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+1 if $EXTRACT(IOST)="P"
SET SRSOUT=1
IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+2 DO ^%ZISC
KILL SRTN
DO ^SRSKILL
WRITE @IOF
+3 QUIT
MORE ; continue looping
+1 SET SRTN=0
FOR
SET SRTN=$ORDER(^TMP("SR",$JOB,SRSNM,SREQDT,SRTN))
if 'SRTN!(SRSOUT)
QUIT
DO PRINT
+2 QUIT
SET ; set ^TMP(
+1 SET SRSS=$PIECE(^SRF(SRTN,0),"^",4)
SET SRSNM=$SELECT(SRSS:$PIECE(^SRO(137.45,SRSS,0),"^"),1:"ZZ")
+2 SET SREQDT=$PIECE($GET(^SRF(SRTN,"1.0")),"^",11)
if 'SREQDT
SET SREQDT="ZZ"
+3 SET ^TMP("SR",$JOB,SRSNM,SREQDT,SRTN)=""
+4 QUIT
PRINT ; print from ^TMP("SR",$J)
+1 IF $Y+7>IOSL
DO PAGE
IF SRSOUT
QUIT
+2 ; << RJS *161
SET S(0)=$GET(^SRF(SRTN,0))
if 'S(0)
QUIT
+3 SET DFN=$PIECE(S(0),"^")
SET CNT=CNT+1
+4 DO DEM^VADPT
SET SRNAME=VADM(1)
SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
SET SRSUR=$PIECE($GET(^SRF(SRTN,.1)),"^",4)
SET SRSUR=$SELECT(SRSUR:$PIECE(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED")
+5 SET SRHRS=$PIECE($GET(^SRF(SRTN,.4)),"^")
SET SRD=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)
+6 if SRHRS=""
SET SRHRS="NOT ENTERED"
SET C=$PIECE(^DD(130,.035,0),"^",2)
SET Y=$PIECE(S(0),"^",10)
if Y'=""
DO Y^DIQ
SET SRTYPE=Y
SET SRANES=$PIECE($GET(^SRF(SRTN,"1.0")),"^")
SET Y=SRANES
SET C=$PIECE(^DD(130,1.01,0),"^",2)
if Y'=""
DO Y^DIQ
SET SRANES=Y
+7 SET SRSORD=$PIECE(S(0),"^",11)
SET SSN=VA("PID")
SET SRWARD=$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"")
IF SRTYPE'=""
SET SRTYPE=" ("_$PIECE(SRTYPE,"(")_")"
+8 KILL SROPS,MM,MMM
SET SROPER=SROPER_SRTYPE
if $LENGTH(SROPER)<63
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>62
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+9 WRITE !!,CNT_".",?5,"Case Number: "_SRTN,?40,"Operation Date: "_SRD,!,?5,"Patient: ",?14,SRNAME,?40,"Ward: ",SRWARD,!,?5,"ID#: ",?14,VA("PID"),?40,"Surgeon: "_SRSUR,!,?5,"Procedure: "_SROPS(1)
+10 IF $DATA(SROPS(2))
WRITE !,?16,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?16,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,?16,SROPS(4)
+11 WRITE !,?5,"Estimated Case Length: "_SRHRS
if SRSORD'=""
WRITE !,?5,"Case Schedule Order: "_SRSORD
if SRANES'=""
WRITE !,?5,"Requested Anesthesia: "_SRANES
+12 KILL SRSCON
IF $DATA(^SRF(SRTN,"CON"))
IF $PIECE(^("CON"),"^")
SET SRSCON=$PIECE(^("CON"),"^")
KILL A
SET SROPER=$PIECE(^SRF(SRSCON,"OP"),"^")
if $LENGTH(SROPER)<65
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>64
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MM=""
QUIT
+13 IF $DATA(SRSCON)
WRITE !,"Concurrent Case # "_SRSCON,!,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,SROPS(3)
+14 QUIT
PAGE IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF X["^"
SET SRSOUT=1
QUIT
+1 if $Y
WRITE @IOF
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 IF $Y+4>IOSL
DO PAGE
QUIT
+3 WRITE !!
FOR LINE=1:1:80
WRITE "="
+4 WRITE !,"REQUESTS FOR "_$SELECT(SRSNM'="ZZ":SRSNM,1:"UNKNOWN"),?70,SRDT,!
FOR LINE=1:1:80
WRITE "-"
+5 QUIT
LOOP ; break procedure if greater than 63 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)'<63
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
