- SROWC3 ;B'HAM ISC/ADM - CLEAN WOUND INFECTION SUMMARY ; [ 07/27/98 2:33 PM ]
- ;;3.0; Surgery ;**50**;24 Jun 93
- 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) I SRCAT=1!(SRCAT=2) 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
- SROWC3 ;B'HAM ISC/ADM - CLEAN WOUND INFECTION SUMMARY ; [ 07/27/98 2:33 PM ]
- +1 ;;3.0; Surgery ;**50**;24 Jun 93
- +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)
- IF SRCAT=1!(SRCAT=2)
- SET SRIN=1
- +5 IF SRIN
- SET SRSS(SRSS)=SRSS(SRSS)+1
- SET SRCOMP=SRCOMP+1
- +6 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