SROREQ3 ;BIR/MAM - REQUESTS FOR A DAY (SHORT FORM) ; [ 12/09/99 11:54 AM ]
;;3.0; Surgery ;**26,48,92**;24 Jun 93
W ! K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print Requests for which Surgical Specialty ? " D ^DIC I Y'>0 S SRSOUT=1 G END
S SRSS=+Y,SRSNM=$P(Y(0),"^")
W ! K IOP,POP,IO("Q"),%ZIS S %ZIS("A")="Print the Requests on which Device: ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END
I $D(IO("Q")) K IO("Q") S ZTDESC="OPERATION REQUESTS (SHORT FORM)",ZTRTN="BEG^SROREQ3",(ZTSAVE("SRSDATE"),ZTSAVE("SRSS"),ZTSAVE("SRSNM"),ZTSAVE("SRSITE*"))="" D ^%ZTLOAD S SRSOUT=1 G END
BEG ; entry when queued
K ^TMP("SR",$J) U IO S (CNT,DFN,SRSOUT)=0,Y=SRSDATE,SRDT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) D D^DIQ S SRSDT=$E(Y,1,12) D HDR Q:SRSOUT
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),$P(^SRF(SRTN,0),"^",4)=SRSS D SET
S SREQDT=0 F S SREQDT=$O(^TMP("SR",$J,SREQDT)) Q:SREQDT=""!(SRSOUT) S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SREQDT,SRTN)) Q:'SRTN!(SRSOUT) D PRINT
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 D ^SRSKILL K SRTN W @IOF
Q
SET ; set ^TMP(
S SREQDT=$P($G(^SRF(SRTN,"1.0")),"^",11) S:'SREQDT SREQDT="ZZ" S ^TMP("SR",$J,SREQDT,SRTN)=""
Q
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
W:$Y @IOF W !,"OPERATION REQUESTS FOR "_SRSNM,?70,SRDT,! F LINE=1:1:80 W "-"
Q
PRINT ; print request info
I $Y+7>IOSL D PAGE I SRSOUT Q
S SR(0)=^SRF(SRTN,0),DFN=$P(^SRF(SRTN,0),"^"),CNT=CNT+1
D DEM^VADPT S SRNAME=VADM(1),SROPER=$P(^SRF(SRTN,"OP"),"^")
S 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)),"^"),SRSDT=$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(SR(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(SR(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: "_SRSDT,!,?5,"Patient: ",?16,SRNAME,?40,"Ward: ",SRWARD,!,?5,"ID#: ",?16,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
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
PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I X["^" S SRSOUT=1 Q
D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROREQ3 3501 printed Dec 13, 2024@02:45:47 Page 2
SROREQ3 ;BIR/MAM - REQUESTS FOR A DAY (SHORT FORM) ; [ 12/09/99 11:54 AM ]
+1 ;;3.0; Surgery ;**26,48,92**;24 Jun 93
+2 WRITE !
KILL DIC
SET DIC("S")="I '$P(^(0),""^"",3)"
SET DIC=137.45
SET DIC(0)="QEAMZ"
SET DIC("A")="Print Requests for which Surgical Specialty ? "
DO ^DIC
IF Y'>0
SET SRSOUT=1
GOTO END
+3 SET SRSS=+Y
SET SRSNM=$PIECE(Y(0),"^")
+4 WRITE !
KILL IOP,POP,IO("Q"),%ZIS
SET %ZIS("A")="Print the Requests on which Device: "
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+5 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="OPERATION REQUESTS (SHORT FORM)"
SET ZTRTN="BEG^SROREQ3"
SET (ZTSAVE("SRSDATE"),ZTSAVE("SRSS"),ZTSAVE("SRSNM"),ZTSAVE("SRSITE*"))=""
DO ^%ZTLOAD
SET SRSOUT=1
GOTO END
BEG ; entry when queued
+1 KILL ^TMP("SR",$JOB)
USE IO
SET (CNT,DFN,SRSOUT)=0
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)
DO HDR
if SRSOUT
QUIT
+2 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)
IF $PIECE(^SRF(SRTN,0),"^",4)=SRSS
DO SET
+3 SET SREQDT=0
FOR
SET SREQDT=$ORDER(^TMP("SR",$JOB,SREQDT))
if SREQDT=""!(SRSOUT)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^TMP("SR",$JOB,SREQDT,SRTN))
if 'SRTN!(SRSOUT)
QUIT
DO PRINT
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
DO ^SRSKILL
KILL SRTN
WRITE @IOF
+3 QUIT
SET ; set ^TMP(
+1 SET SREQDT=$PIECE($GET(^SRF(SRTN,"1.0")),"^",11)
if 'SREQDT
SET SREQDT="ZZ"
SET ^TMP("SR",$JOB,SREQDT,SRTN)=""
+2 QUIT
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 if $Y
WRITE @IOF
WRITE !,"OPERATION REQUESTS FOR "_SRSNM,?70,SRDT,!
FOR LINE=1:1:80
WRITE "-"
+3 QUIT
PRINT ; print request info
+1 IF $Y+7>IOSL
DO PAGE
IF SRSOUT
QUIT
+2 SET SR(0)=^SRF(SRTN,0)
SET DFN=$PIECE(^SRF(SRTN,0),"^")
SET CNT=CNT+1
+3 DO DEM^VADPT
SET SRNAME=VADM(1)
SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
+4 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 SRSDT=$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(SR(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(SR(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: "_SRSDT,!,?5,"Patient: ",?16,SRNAME,?40,"Ward: ",SRWARD,!,?5,"ID#: ",?16,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
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
PAGE IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF X["^"
SET SRSOUT=1
QUIT
+1 DO HDR
+2 QUIT
