SROREQ2 ;BIR/MAM - REQUEST FOR A DAY (CONT) ;12/09/99
;;3.0;Surgery;**48,77,92,109,178**;24 Jun 93;Build 6
;
; Reference to ^LAB(66 supported by DBIA #210
;
BEG ; entry when queued
K ^TMP("SR",$J) U IO S Y=SRSDATE D D^DIQ S SRSDT=Y
S (SRHDR,SRSOUT)=0 D PAGE Q:SRSOUT
S DFN=0 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
I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
D ^%ZISC W @IOF K SRTN D ^SRSKILL
Q
PAGE I SRHDR,$E(IOST)'="P" W !!,"Press <RET to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
D HDR^SROREQ
Q
SET ; set ^TMP(
S SREQDT=$P($G(^SRF(SRTN,"1.0")),"^",11) S:'SREQDT SREQDT="ZZ" S ^TMP("SR",$J,SREQDT,SRTN)=DFN
Q
PRINT ; print requests
I $Y+20>IOSL D PAGE I SRSOUT Q
S DFN=^TMP("SR",$J,SREQDT,SRTN) D DEM^VADPT S SRNAME=VADM(1),SRSSN=VA("PID"),SRWARD=$S($D(^DPT(DFN,.1)):^(.1),1:"NOT ENTERED"),AGE=VADM(4)
S SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:"")
S SROSUR=$P(SR(.1),"^",4),SROATT=$P(SR(.1),"^",13),SROPER=$P(^SRF(SRTN,"OP"),"^") K SROP S (X,CNT)=0 F S X=$O(^SRF(SRTN,13,X)) Q:'X S CNT=CNT+1,SROP(CNT)=$P(^SRF(SRTN,13,X,0),"^")
K SROPS,MM,MMM S:$L(SROPER)<56 SROPS(1)=SROPER I $L(SROPER)>55 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
S:SROSUR SROSUR=$P(^VA(200,SROSUR,0),"^") I SROATT S SROATT=$P(^VA(200,SROATT,0),"^")
S SRDIAG=$S($D(^SRF(SRTN,33)):$P(^(33),"^"),1:"") I SRDIAG="" S SRDIAG="NOT ENTERED"
S Y=SREQDT D D^DIQ S SREQDAY=$S('$E(Y):$E(Y,1,12)_" "_$E(Y,14,18),1:"") S SR("1.0")=$S($D(^SRF(SRTN,"1.0")):^("1.0"),1:"")
S SRSPER=$P(SR("1.0"),"^",10) S:SRSPER SRSPER=$P(^VA(200,SRSPER,0),"^")
S Y=$P(SR("1.0"),"^"),C=$P(^DD(130,1.01,0),"^",2) D:Y'="" Y^DIQ S SRANES=$S(Y'="":Y,1:"NOT ENTERED")
K BLOOD S (CNT,X)=0 F S X=$O(^SRF(SRTN,11,X)) Q:'X S CNT=CNT+1,Y=$P(^SRF(SRTN,11,X,0),"^"),MM=$P(^(0),"^",2) S BLOOD(CNT)=Y_" "_MM_" UNITS" ;RLM
S SRPOS=$S($D(^SRF(SRTN,.5)):$P(^(.5),"^",3),1:"") I SRPOS S SRPOS=$P(^SRO(132,SRPOS,0),"^")
S SRLENGTH=$S($D(^SRF(SRTN,.4)):$P(^(.4),"^"),1:"NOT ENTERED")
S SRORDER=$P(^SRF(SRTN,0),"^",11)
W ! F LINE=1:1:80 W "-"
W !!,"Patient: "_SRNAME,?40,"ID #: "_VA("PID"),!,"Age: "_AGE,?40,"Ward: "_SRWARD,!!,"Surgeon: "_SROSUR,?40,"Attending: "_SROATT,!,"Preoperative Diagnosis: "_SRDIAG
W !!,"Principal Procedure:",?22,SROPS(1) I $D(SROPS(2)) W !,?22,SROPS(2) I $D(SROPS(3)) W !,?22,SROPS(3) I $D(SROPS(4)) W !,?22,SROPS(4) I $D(SROPS(5)) W !,?22,SROPS(5)
I $O(SROP(0)) W !,"Other Procedures:",?22,SROP(1) S CNT=1 F I=0:0 S CNT=$O(SROP(CNT)) Q:'CNT W !,?22,SROP(CNT)
W !,"Estimated Case Length: "_SRLENGTH I SRPOS'="" W ?40,"Position: "_SRPOS
I SRORDER'="" W !,"Case Schedule Order: "_SRORDER
W !!,"Req. Anesthesia Technique: "_SRANES
I $O(BLOOD(0)) W !,"Blood Requested: ",?22,BLOOD(1) I $D(BLOOD(2)) W !,?22,BLOOD(2) I $D(BLOOD(3)) W !,?22,BLOOD(3)
I SRSPER'="" W !,"Requested by: "_SRSPER W:SREQDAY'="" " on "_SREQDAY
I $O(^SRF(SRTN,5,0)) W !!,"Comments: " S X=0 F S X=$O(^SRF(SRTN,5,X)) Q:'X W !,^SRF(SRTN,5,X,0)
W ! Q
LOOP ; break procedure if greater than 55 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)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROREQ2 3573 printed Dec 13, 2024@02:45:46 Page 2
SROREQ2 ;BIR/MAM - REQUEST FOR A DAY (CONT) ;12/09/99
+1 ;;3.0;Surgery;**48,77,92,109,178**;24 Jun 93;Build 6
+2 ;
+3 ; Reference to ^LAB(66 supported by DBIA #210
+4 ;
BEG ; entry when queued
+1 KILL ^TMP("SR",$JOB)
USE IO
SET Y=SRSDATE
DO D^DIQ
SET SRSDT=Y
+2 SET (SRHDR,SRSOUT)=0
DO PAGE
if SRSOUT
QUIT
+3 SET DFN=0
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
+4 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 'SRSOUT
IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+2 DO ^%ZISC
WRITE @IOF
KILL SRTN
DO ^SRSKILL
+3 QUIT
PAGE IF SRHDR
IF $EXTRACT(IOST)'="P"
WRITE !!,"Press <RET to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 DO HDR^SROREQ
+2 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)=DFN
+2 QUIT
PRINT ; print requests
+1 IF $Y+20>IOSL
DO PAGE
IF SRSOUT
QUIT
+2 SET DFN=^TMP("SR",$JOB,SREQDT,SRTN)
DO DEM^VADPT
SET SRNAME=VADM(1)
SET SRSSN=VA("PID")
SET SRWARD=$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"NOT ENTERED")
SET AGE=VADM(4)
+3 SET SR(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")
+4 SET SROSUR=$PIECE(SR(.1),"^",4)
SET SROATT=$PIECE(SR(.1),"^",13)
SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
KILL SROP
SET (X,CNT)=0
FOR
SET X=$ORDER(^SRF(SRTN,13,X))
if 'X
QUIT
SET CNT=CNT+1
SET SROP(CNT)=$PIECE(^SRF(SRTN,13,X,0),"^")
+5 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<56
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>55
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+6 if SROSUR
SET SROSUR=$PIECE(^VA(200,SROSUR,0),"^")
IF SROATT
SET SROATT=$PIECE(^VA(200,SROATT,0),"^")
+7 SET SRDIAG=$SELECT($DATA(^SRF(SRTN,33)):$PIECE(^(33),"^"),1:"")
IF SRDIAG=""
SET SRDIAG="NOT ENTERED"
+8 SET Y=SREQDT
DO D^DIQ
SET SREQDAY=$SELECT('$EXTRACT(Y):$EXTRACT(Y,1,12)_" "_$EXTRACT(Y,14,18),1:"")
SET SR("1.0")=$SELECT($DATA(^SRF(SRTN,"1.0")):^("1.0"),1:"")
+9 SET SRSPER=$PIECE(SR("1.0"),"^",10)
if SRSPER
SET SRSPER=$PIECE(^VA(200,SRSPER,0),"^")
+10 SET Y=$PIECE(SR("1.0"),"^")
SET C=$PIECE(^DD(130,1.01,0),"^",2)
if Y'=""
DO Y^DIQ
SET SRANES=$SELECT(Y'="":Y,1:"NOT ENTERED")
+11 ;RLM
KILL BLOOD
SET (CNT,X)=0
FOR
SET X=$ORDER(^SRF(SRTN,11,X))
if 'X
QUIT
SET CNT=CNT+1
SET Y=$PIECE(^SRF(SRTN,11,X,0),"^")
SET MM=$PIECE(^(0),"^",2)
SET BLOOD(CNT)=Y_" "_MM_" UNITS"
+12 SET SRPOS=$SELECT($DATA(^SRF(SRTN,.5)):$PIECE(^(.5),"^",3),1:"")
IF SRPOS
SET SRPOS=$PIECE(^SRO(132,SRPOS,0),"^")
+13 SET SRLENGTH=$SELECT($DATA(^SRF(SRTN,.4)):$PIECE(^(.4),"^"),1:"NOT ENTERED")
+14 SET SRORDER=$PIECE(^SRF(SRTN,0),"^",11)
+15 WRITE !
FOR LINE=1:1:80
WRITE "-"
+16 WRITE !!,"Patient: "_SRNAME,?40,"ID #: "_VA("PID"),!,"Age: "_AGE,?40,"Ward: "_SRWARD,!!,"Surgeon: "_SROSUR,?40,"Attending: "_SROATT,!,"Preoperative Diagnosis: "_SRDIAG
+17 WRITE !!,"Principal Procedure:",?22,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?22,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?22,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,?22,SROPS(4)
IF $DATA(SROPS(5))
WRITE !,?22,SROPS(5)
+18 IF $ORDER(SROP(0))
WRITE !,"Other Procedures:",?22,SROP(1)
SET CNT=1
FOR I=0:0
SET CNT=$ORDER(SROP(CNT))
if 'CNT
QUIT
WRITE !,?22,SROP(CNT)
+19 WRITE !,"Estimated Case Length: "_SRLENGTH
IF SRPOS'=""
WRITE ?40,"Position: "_SRPOS
+20 IF SRORDER'=""
WRITE !,"Case Schedule Order: "_SRORDER
+21 WRITE !!,"Req. Anesthesia Technique: "_SRANES
+22 IF $ORDER(BLOOD(0))
WRITE !,"Blood Requested: ",?22,BLOOD(1)
IF $DATA(BLOOD(2))
WRITE !,?22,BLOOD(2)
IF $DATA(BLOOD(3))
WRITE !,?22,BLOOD(3)
+23 IF SRSPER'=""
WRITE !,"Requested by: "_SRSPER
if SREQDAY'=""
WRITE " on "_SREQDAY
+24 IF $ORDER(^SRF(SRTN,5,0))
WRITE !!,"Comments: "
SET X=0
FOR
SET X=$ORDER(^SRF(SRTN,5,X))
if 'X
QUIT
WRITE !,^SRF(SRTN,5,X,0)
+25 WRITE !
QUIT
LOOP ; break procedure if greater than 55 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)'<55
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
