SRONUR2 ;B'HAM ISC/MAM - NURSE STAFF REPORT (1) ; [ 09/22/98 11:36 AM ]
;;3.0; Surgery ;**77,50**;24 Jun 93
DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) Q:SRSOUT
K %ZIS,IOP,IO("Q"),POP S %ZIS="QM",%ZIS("A")="Print the Report on which Device: " W !!,"This report is designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 Q
I $D(IO("Q")) K IO("Q") S ZTDESC="SURGICAL NURSE STAFFING REPORT",ZTRTN="BEG^SRONUR2",(ZTSAVE("SRSD*"),ZTSAVE("SRED*"),ZTSAVE("SRINST"),ZTSAVE("SRONUR*"),ZTSAVE("SRSITE*"))="" D ^%ZTLOAD Q
D BEG
Q
SET ; set variables
I $Y+6>IOSL D PAGE Q:SRSOUT
S MATCH=0,SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT S SRNM=VADM(1),SSN=VA("PID") S:$L(SRNM)>25 SRNM=$P(SRNM,",")_", "_$E($P(SRNM,",",2))
S SROD=$P(SR(0),"^",9),SROD=$E(SROD,4,5)_"/"_$E(SROD,6,7)_"/"_$E(SROD,2,3)
K SCRUB S SCRUB(1)="",(SCRUB,CNT)=0 F I=0:0 S SCRUB=$O(^SRF(SRTN,23,SCRUB)) Q:'SCRUB S CNT=CNT+1,Y=$P(^SRF(SRTN,23,SCRUB,0),"^"),X=$P(^VA(200,Y,0),"^") S:$L(X)>17 X=$P(X,",")_", "_$E($P(X,",",2)) S SCRUB(CNT)=X I Y=SRONUR S MATCH=1
K CIRC S CIRC(1)="",(CIRC,CNT)=0 F I=0:0 S CIRC=$O(^SRF(SRTN,19,CIRC)) Q:'CIRC S CNT=CNT+1,Y=$P(^SRF(SRTN,19,CIRC,0),"^"),X=$P(^VA(200,Y,0),"^") S:$L(X)>17 SX=$P(X,",")_", "_$E($P(X,",",2)) S CIRC(CNT)=X I Y=SRONUR S MATCH=1
Q:'MATCH
OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OP=0 F I=0:0 S OP=$O(^SRF(SRTN,13,OP)) Q:'OP D OTHER
K SROPS,MM,MMM S:$L(SROPER)<50 SROPS(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
S SR(.2)=^SRF(SRTN,.2),SRTI=$P(SR(.2),"^",10),SRTO=$P(SR(.2),"^",12),X=SRTI,X1=SRTO D MINS^SRSUTL2 S SRET=X
S Y=SRTI D D^DIQ S SRFIND=$F(Y,":"),SRTI=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"")
S Y=SRTO D D^DIQ S SRFIND=$F(Y,":"),SRTO=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"")
S:SRTI="" (SRTI,SRET)="-"
PRINT ; print information
W !!,SROD,?9,SRNM,?35,SROPS(1),?87,$E(SCRUB(1),1,22),?106,$E(CIRC(1),1,22),?125,SRTI
W !,SRTN,?9,VA("PID") W:$D(SROPS(2)) ?35,SROPS(2) W:$D(SCRUB(2)) ?87,$E(SCRUB(2),1,18) W:$D(CIRC(2)) ?106,$E(CIRC(2),1,18) W ?125,SRTO
W ! W:$D(SROPS(3)) ?35,SROPS(3) W:$D(SCRUB(3)) ?87,$E(SCRUB(3),1,18) W:$D(CIRC(3)) ?106,$E(CIRC(3),1,18) W ?125,SRET
S MORE=4 I $D(SROPS(4)) S MORE=5 W !,?35,SROPS(4) W:$D(SCRUB(4)) ?87,$E(SCRUB(4),1,18) I $D(CIRC(4)) W ?106,$E(CIRC(4),1,18)
F I=MORE:1:10 I $D(SCRUB(I))!$D(CIRC(I)) W ! W:$D(SCRUB(I)) ?87,$E(SCRUB(I),1,18) W:$D(CIRC(I)) ?106,$E(CIRC(I),1,18)
Q
OTHER ; other operations
S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OP,0),"^"))>250 S SRLONG=0,OP=999,SROPERS=" ..."
I SRLONG S SROPERS=$P(^SRF(SRTN,13,OP,0),"^")
S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
Q
LOOP ; break procedure if greater than 50 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)'<50 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?120,"PAGE: "_PAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?51,"SURGICAL NURSE STAFFING REPORT",?100,"DATE REVIEWED: "
W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
W !!,"DATE",?10,"PATIENT",?35,"OPERATION(S)",?87,"SCRUB NURSE",?105,"CIRC. NURSE",?122,"TIME IN",!,"CASE #",?12,"ID#",?122,"TIME OUT",!,?118,"ELAPSED (MINS)",! F I=1:1:IOM W "="
S PAGE=PAGE+1
Q
PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
D HDR
Q
BEG ; entry when queued
U IO S SRSDT=SRSD-.0001,SREDT=SRED+.9999,SRSOUT=0,PAGE=1
S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y D HDR
F S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT!(SRSDT>SREDT)!(SRSOUT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN!(SRSOUT) I $D(^SRF(SRTN,0)),$P($G(^SRF(SRTN,.2)),"^",12)'="",$$DIV^SROUTL0(SRTN) D SET
W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRONUR2 3958 printed Apr 09, 2024@21:51:05 Page 2
SRONUR2 ;B'HAM ISC/MAM - NURSE STAFF REPORT (1) ; [ 09/22/98 11:36 AM ]
+1 ;;3.0; Surgery ;**77,50**;24 Jun 93
DATE DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)
if SRSOUT
QUIT
+1 KILL %ZIS,IOP,IO("Q"),POP
SET %ZIS="QM"
SET %ZIS("A")="Print the Report on which Device: "
WRITE !!,"This report is designed to use a 132 column format.",!
DO ^%ZIS
IF POP
SET SRSOUT=1
QUIT
+2 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="SURGICAL NURSE STAFFING REPORT"
SET ZTRTN="BEG^SRONUR2"
SET (ZTSAVE("SRSD*"),ZTSAVE("SRED*"),ZTSAVE("SRINST"),ZTSAVE("SRONUR*"),ZTSAVE("SRSITE*"))=""
DO ^%ZTLOAD
QUIT
+3 DO BEG
+4 QUIT
SET ; set variables
+1 IF $Y+6>IOSL
DO PAGE
if SRSOUT
QUIT
+2 SET MATCH=0
SET SR(0)=^SRF(SRTN,0)
SET DFN=$PIECE(SR(0),"^")
DO DEM^VADPT
SET SRNM=VADM(1)
SET SSN=VA("PID")
if $LENGTH(SRNM)>25
SET SRNM=$PIECE(SRNM,",")_", "_$EXTRACT($PIECE(SRNM,",",2))
+3 SET SROD=$PIECE(SR(0),"^",9)
SET SROD=$EXTRACT(SROD,4,5)_"/"_$EXTRACT(SROD,6,7)_"/"_$EXTRACT(SROD,2,3)
+4 KILL SCRUB
SET SCRUB(1)=""
SET (SCRUB,CNT)=0
FOR I=0:0
SET SCRUB=$ORDER(^SRF(SRTN,23,SCRUB))
if 'SCRUB
QUIT
SET CNT=CNT+1
SET Y=$PIECE(^SRF(SRTN,23,SCRUB,0),"^")
SET X=$PIECE(^VA(200,Y,0),"^")
if $LENGTH(X)>17
SET X=$PIECE(X,",")_", "_$EXTRACT($PIECE(X,",",2))
SET SCRUB(CNT)=X
IF Y=SRONUR
SET MATCH=1
+5 KILL CIRC
SET CIRC(1)=""
SET (CIRC,CNT)=0
FOR I=0:0
SET CIRC=$ORDER(^SRF(SRTN,19,CIRC))
if 'CIRC
QUIT
SET CNT=CNT+1
SET Y=$PIECE(^SRF(SRTN,19,CIRC,0),"^")
SET X=$PIECE(^VA(200,Y,0),"^")
if $LENGTH(X)>17
SET SX=$PIECE(X,",")_", "_$EXTRACT($PIECE(X,",",2))
SET CIRC(CNT)=X
IF Y=SRONUR
SET MATCH=1
+6 if 'MATCH
QUIT
OPS SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
SET OP=0
FOR I=0:0
SET OP=$ORDER(^SRF(SRTN,13,OP))
if 'OP
QUIT
DO OTHER
+1 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<50
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>49
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+2 SET SR(.2)=^SRF(SRTN,.2)
SET SRTI=$PIECE(SR(.2),"^",10)
SET SRTO=$PIECE(SR(.2),"^",12)
SET X=SRTI
SET X1=SRTO
DO MINS^SRSUTL2
SET SRET=X
+3 SET Y=SRTI
DO D^DIQ
SET SRFIND=$FIND(Y,":")
SET SRTI=$SELECT(SRFIND:$EXTRACT(Y,SRFIND-3,SRFIND+1),1:"")
+4 SET Y=SRTO
DO D^DIQ
SET SRFIND=$FIND(Y,":")
SET SRTO=$SELECT(SRFIND:$EXTRACT(Y,SRFIND-3,SRFIND+1),1:"")
+5 if SRTI=""
SET (SRTI,SRET)="-"
PRINT ; print information
+1 WRITE !!,SROD,?9,SRNM,?35,SROPS(1),?87,$EXTRACT(SCRUB(1),1,22),?106,$EXTRACT(CIRC(1),1,22),?125,SRTI
+2 WRITE !,SRTN,?9,VA("PID")
if $DATA(SROPS(2))
WRITE ?35,SROPS(2)
if $DATA(SCRUB(2))
WRITE ?87,$EXTRACT(SCRUB(2),1,18)
if $DATA(CIRC(2))
WRITE ?106,$EXTRACT(CIRC(2),1,18)
WRITE ?125,SRTO
+3 WRITE !
if $DATA(SROPS(3))
WRITE ?35,SROPS(3)
if $DATA(SCRUB(3))
WRITE ?87,$EXTRACT(SCRUB(3),1,18)
if $DATA(CIRC(3))
WRITE ?106,$EXTRACT(CIRC(3),1,18)
WRITE ?125,SRET
+4 SET MORE=4
IF $DATA(SROPS(4))
SET MORE=5
WRITE !,?35,SROPS(4)
if $DATA(SCRUB(4))
WRITE ?87,$EXTRACT(SCRUB(4),1,18)
IF $DATA(CIRC(4))
WRITE ?106,$EXTRACT(CIRC(4),1,18)
+5 FOR I=MORE:1:10
IF $DATA(SCRUB(I))!$DATA(CIRC(I))
WRITE !
if $DATA(SCRUB(I))
WRITE ?87,$EXTRACT(SCRUB(I),1,18)
if $DATA(CIRC(I))
WRITE ?106,$EXTRACT(CIRC(I),1,18)
+6 QUIT
OTHER ; other operations
+1 SET SRLONG=1
IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OP,0),"^"))>250
SET SRLONG=0
SET OP=999
SET SROPERS=" ..."
+2 IF SRLONG
SET SROPERS=$PIECE(^SRF(SRTN,13,OP,0),"^")
+3 SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)
+4 QUIT
LOOP ; break procedure if greater than 50 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)'<50
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 if $Y
WRITE @IOF
WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,?120,"PAGE: "_PAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?51,"SURGICAL NURSE STAFFING REPORT",?100,"DATE REVIEWED: "
+3 WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,SRPRINT
+4 WRITE !!,"DATE",?10,"PATIENT",?35,"OPERATION(S)",?87,"SCRUB NURSE",?105,"CIRC. NURSE",?122,"TIME IN",!,"CASE #",?12,"ID#",?122,"TIME OUT",!,?118,"ELAPSED (MINS)",!
FOR I=1:1:IOM
WRITE "="
+5 SET PAGE=PAGE+1
+6 QUIT
PAGE IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 DO HDR
+2 QUIT
BEG ; entry when queued
+1 USE IO
SET SRSDT=SRSD-.0001
SET SREDT=SRED+.9999
SET SRSOUT=0
SET PAGE=1
+2 SET Y=SRSD
XECUTE ^DD("DD")
SET SRFRTO="FROM: "_Y_" TO: "
SET Y=SRED
XECUTE ^DD("DD")
SET SRFRTO=SRFRTO_Y
SET Y=DT
XECUTE ^DD("DD")
SET SRPRINT="DATE PRINTED: "_Y
DO HDR
+3 FOR
SET SRSDT=$ORDER(^SRF("AC",SRSDT))
if 'SRSDT!(SRSDT>SREDT)!(SRSOUT)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))
if 'SRTN!(SRSOUT)
QUIT
IF $DATA(^SRF(SRTN,0))
IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)'=""
IF $$DIV^SROUTL0(SRTN)
DO SET
+4 if $EXTRACT(IOST)="P"
WRITE @IOF
IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
+5 QUIT
