- 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 Feb 19, 2025@00:13:09 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
