SROWC3 ;BIR/ADM - CLEAN WOUND INFECTION SUMMARY ;12/16/2010
;;3.0;Surgery;**50,175**;24 Jun 93;Build 6
S (SRCLEAN,SRCOMP,SRHDR,SRSOUT,SRSS)=0
I 'SRSP D ALL G WC
I SRSP D SPEC G WC
Q
ALL F S SRSS=$O(^SRO(137.45,SRSS)) Q:'SRSS S (SRSS(SRSS),SRC(SRSS))=0
S (SRSS("ZZ"),SRC("ZZ"))=0
Q
SPEC F S SRSS=$O(SRSP(SRSS)) Q:'SRSS S (SRSS(SRSS),SRC(SRSS))=0
Q
WC F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED) S SROP=0 F S SROP=$O(^SRF("AC",SRSD,SROP)) Q:'SROP I $D(^SRF(SROP,0)),$$MANDIV^SROUTL0(SRINSTP,SROP) D SET
D HDR S SRSS="" F S SRSS=$O(SRSS(SRSS)) Q:SRSS=""!(SRSOUT) D PRINT G:SRSOUT END
D:'SRSP TOTAL D END
Q
SET Q:$P($G(^SRF(SROP,30)),"^")'="" Q:$P($G(^SRF(SROP,.2)),"^",12)=""
S SRSS=$P(^SRF(SROP,0),"^",4) S:SRSS="" SRSS="ZZ" I SRSP,'$D(SRSP(SRSS)) Q
S SRWC=$P($G(^SRF(SROP,"1.0")),"^",8) I SRWC'="C" Q
S SRC(SRSS)=SRC(SRSS)+1,SRCLEAN=SRCLEAN+1
S (SRC,SRIN)=0 F S SRC=$O(^SRF(SROP,16,SRC)) Q:'SRC S SRCAT=$P(^SRF(SROP,16,SRC,0),"^",2) D
.I SRCAT=1!(SRCAT=2)!(SRCAT=35) S SRIN=1 Q
.I $P($G(^SRF(SROP,"RA")),"^",2)="C",SRCAT=23!(SRCAT=25) S SRIN=1
I SRIN S SRSS(SRSS)=SRSS(SRSS)+1,SRCOMP=SRCOMP+1
Q
PRINT ; print info
I $Y+5>IOSL D HDR I SRSOUT Q
S SRSPEC=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"NO SPECIALTY ENTERED")
W !,$P(SRSPEC,"("),?27,$J(SRC(SRSS),5),?42,$J(SRSS(SRSS),5) S:SRC(SRSS)=0 SRC(SRSS)=1 W ?59,$J((SRSS(SRSS)/SRC(SRSS)*100),5,1),"%"
Q
TOTAL ; print total
W !!,"TOTAL",?27,$J(SRCLEAN,5),?42,$J(SRCOMP,5) S:SRCLEAN=0 SRCLEAN=1 W ?59,$J((SRCOMP/SRCLEAN*100),5,1),"%"
Q
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
D ^%ZISC,^SRSKILL W @IOF
Q
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
I $E(IOST)'="P",SRHDR W !!,"Press RETURN to continue or '^' to quit. " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
W:$Y @IOF W:$E(IOST)'="C" !,?(80-$L(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE" W !,?25,"CLEAN WOUND INFECTION SUMMARY"
W !,?(80-$L(SRFRTO)\2),SRFRTO
I $E(IOST)'="P" W ! F LINE=1:1:80 W "-"
I $E(IOST)'="C" W !,?(80-$L(SRPRINT)\2),SRPRINT,!,?19,"REVIEWED BY:",?45,"DATE REVIEWED:"
W !!,"SURGICAL SERVICE",?24,"CLEAN WOUNDS",?40,"INFECTIONS",?54,"INFECTION RATE",! I $E(IOST)'="C" F LINE=1:1:80 W "="
S SRHDR=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROWC3 2326 printed Apr 09, 2024@21:41:57 Page 2
SROWC3 ;BIR/ADM - CLEAN WOUND INFECTION SUMMARY ;12/16/2010
+1 ;;3.0;Surgery;**50,175**;24 Jun 93;Build 6
+2 SET (SRCLEAN,SRCOMP,SRHDR,SRSOUT,SRSS)=0
+3 IF 'SRSP
DO ALL
GOTO WC
+4 IF SRSP
DO SPEC
GOTO WC
+5 QUIT
ALL FOR
SET SRSS=$ORDER(^SRO(137.45,SRSS))
if 'SRSS
QUIT
SET (SRSS(SRSS),SRC(SRSS))=0
+1 SET (SRSS("ZZ"),SRC("ZZ"))=0
+2 QUIT
SPEC FOR
SET SRSS=$ORDER(SRSP(SRSS))
if 'SRSS
QUIT
SET (SRSS(SRSS),SRC(SRSS))=0
+1 QUIT
WC FOR
SET SRSD=$ORDER(^SRF("AC",SRSD))
if 'SRSD!(SRSD>SRED)
QUIT
SET SROP=0
FOR
SET SROP=$ORDER(^SRF("AC",SRSD,SROP))
if 'SROP
QUIT
IF $DATA(^SRF(SROP,0))
IF $$MANDIV^SROUTL0(SRINSTP,SROP)
DO SET
+1 DO HDR
SET SRSS=""
FOR
SET SRSS=$ORDER(SRSS(SRSS))
if SRSS=""!(SRSOUT)
QUIT
DO PRINT
if SRSOUT
GOTO END
+2 if 'SRSP
DO TOTAL
DO END
+3 QUIT
SET if $PIECE($GET(^SRF(SROP,30)),"^")'=""
QUIT
if $PIECE($GET(^SRF(SROP,.2)),"^",12)=""
QUIT
+1 SET SRSS=$PIECE(^SRF(SROP,0),"^",4)
if SRSS=""
SET SRSS="ZZ"
IF SRSP
IF '$DATA(SRSP(SRSS))
QUIT
+2 SET SRWC=$PIECE($GET(^SRF(SROP,"1.0")),"^",8)
IF SRWC'="C"
QUIT
+3 SET SRC(SRSS)=SRC(SRSS)+1
SET SRCLEAN=SRCLEAN+1
+4 SET (SRC,SRIN)=0
FOR
SET SRC=$ORDER(^SRF(SROP,16,SRC))
if 'SRC
QUIT
SET SRCAT=$PIECE(^SRF(SROP,16,SRC,0),"^",2)
Begin DoDot:1
+5 IF SRCAT=1!(SRCAT=2)!(SRCAT=35)
SET SRIN=1
QUIT
+6 IF $PIECE($GET(^SRF(SROP,"RA")),"^",2)="C"
IF SRCAT=23!(SRCAT=25)
SET SRIN=1
End DoDot:1
+7 IF SRIN
SET SRSS(SRSS)=SRSS(SRSS)+1
SET SRCOMP=SRCOMP+1
+8 QUIT
PRINT ; print info
+1 IF $Y+5>IOSL
DO HDR
IF SRSOUT
QUIT
+2 SET SRSPEC=$SELECT(SRSS:$PIECE(^SRO(137.45,SRSS,0),"^"),1:"NO SPECIALTY ENTERED")
+3 WRITE !,$PIECE(SRSPEC,"("),?27,$JUSTIFY(SRC(SRSS),5),?42,$JUSTIFY(SRSS(SRSS),5)
if SRC(SRSS)=0
SET SRC(SRSS)=1
WRITE ?59,$JUSTIFY((SRSS(SRSS)/SRC(SRSS)*100),5,1),"%"
+4 QUIT
TOTAL ; print total
+1 WRITE !!,"TOTAL",?27,$JUSTIFY(SRCLEAN,5),?42,$JUSTIFY(SRCOMP,5)
if SRCLEAN=0
SET SRCLEAN=1
WRITE ?59,$JUSTIFY((SRCOMP/SRCLEAN*100),5,1),"%"
+2 QUIT
END if $EXTRACT(IOST)="P"
WRITE @IOF
IF $DATA(ZTQUEUED)
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
DO ^SRSKILL
WRITE @IOF
+3 QUIT
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 IF $EXTRACT(IOST)'="P"
IF SRHDR
WRITE !!,"Press RETURN to continue or '^' to quit. "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+3 if $Y
WRITE @IOF
if $EXTRACT(IOST)'="C"
WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE"
WRITE !,?25,"CLEAN WOUND INFECTION SUMMARY"
+4 WRITE !,?(80-$LENGTH(SRFRTO)\2),SRFRTO
+5 IF $EXTRACT(IOST)'="P"
WRITE !
FOR LINE=1:1:80
WRITE "-"
+6 IF $EXTRACT(IOST)'="C"
WRITE !,?(80-$LENGTH(SRPRINT)\2),SRPRINT,!,?19,"REVIEWED BY:",?45,"DATE REVIEWED:"
+7 WRITE !!,"SURGICAL SERVICE",?24,"CLEAN WOUNDS",?40,"INFECTIONS",?54,"INFECTION RATE",!
IF $EXTRACT(IOST)'="C"
FOR LINE=1:1:80
WRITE "="
+8 SET SRHDR=1
+9 QUIT
