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  Sep 23, 2025@20:23:06                                                                                                                                                                                                      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