- SROWC1 ;B'HAM ISC/ADM - WOUND CLASSIFICATION REPORT (CONT.) ; [ 08/02/00 8:09 AM ]
- ;;3.0; Surgery ;**50,95**;24 Jun 93
- U IO N SRFRTO S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y,SRSD=SRSD-.0001,SRED=SRED+.9999,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y
- I SRFLG=2 G ^SROWC2
- I SRFLG=3 G ^SROWC3
- S (SRHDR,SRSOUT,SRSS,SRCT)=0 K ^TMP("SR",$J),^TMP("SRT",$J),^TMP("SRTN",$J)
- 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 ^TMP("SR",$J,SRSS)="0^0^0^0^0"
- S ^TMP("SR",$J,"ZZ")="0^0^0^0^0"
- Q
- SPEC F S SRSS=$O(SRSP(SRSS)) Q:'SRSS S ^TMP("SR",$J,SRSS)="0^0^0^0^0"
- Q
- WC S ^TMP("SRT",$J)="0^0^0^0^0^0",SRCOMP=0
- 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 UTIL
- D HDR S SRSS="" F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!(SRSOUT) S SRCT=SRCT+1 D PRINT
- D TOTAL,END
- Q
- UTIL ; set ^TMP
- 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),SRP=$S(SRWC="C":1,SRWC="CC":2,SRWC="D":3,SRWC="I":4,1:5)
- S $P(^TMP("SR",$J,SRSS),"^",SRP)=$P(^TMP("SR",$J,SRSS),"^",SRP)+1 S:SRP=5 ^TMP("SRTN",$J,SRSS,SRSD,SROP)=""
- S $P(^TMP("SRT",$J),"^",SRP)=$P(^TMP("SRT",$J),"^",SRP)+1,$P(^TMP("SRT",$J),"^",6)=$P(^TMP("SRT",$J),"^",6)+1
- I SRP=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 SRP=1,SRIN S 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")
- S Y=^TMP("SR",$J,SRSS),SRC=$P(Y,"^"),SRCC=$P(Y,"^",2),SRD=$P(Y,"^",3),SRI=$P(Y,"^",4),SRZZ=$P(Y,"^",5)
- I 'SRSP,'(SRC+SRCC+SRD+SRI+SRZZ) Q
- W !,$P(SRSPEC,"("),?21,$J(SRC,5),?33,$J(SRCC,5),?47,$J(SRD,5),?61,$J(SRI,5),?73,$J(SRZZ,5)
- Q
- TOTAL ; print totals
- Q:SRSOUT I $Y+8>IOSL D HDR I SRSOUT Q
- S Y=^TMP("SRT",$J),SRC=$P(Y,"^"),SRCC=$P(Y,"^",2),SRD=$P(Y,"^",3),SRI=$P(Y,"^",4),SRZZ=$P(Y,"^",5),SRT=$P(Y,"^",6)
- I SRCT>1 W !!,"SUB TOTAL:",?21,$J(SRC,5),?33,$J(SRCC,5),?47,$J(SRD,5),?61,$J(SRI,5),?73,$J(SRZZ,5)
- W !!,"TOTAL: ",SRT S:SRC=0 SRC=1 W !!,"CLEAN WOUND INFECTION RATE: ",$J((SRCOMP/SRC*100),5,1),"%"
- Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
- I $E(IOST)'="P" D HDR1 Q
- W:$Y @IOF W !,?(80-$L(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE",!,?26,"WOUND CLASSIFICATION REPORT",!,?(80-$L(SRFRTO)\2),SRFRTO,!,?(80-$L(SRPRINT)\2),SRPRINT
- W !,?21,"REVIEWED BY:",?45,"DATE REVIEWED:",!
- W !,?34,"CLEAN",?72,"NO CLASS",!,"SURGICAL SERVICE",?22,"CLEAN",?31,"CONTAMINATED",?46,"CONTAMINATED",?61,"INFECTED",?73,"ENTERED"
- W ! F LINE=1:1:80 W "="
- W ! Q
- HDR1 ; print heading to screen
- I SRHDR W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
- W @IOF,!,?26,"WOUND CLASSIFICATION REPORT",!,?(80-$L(SRFRTO)\2),SRFRTO
- W ! F LINE=1:1:80 W "-"
- W !!,?34,"CLEAN",?72,"NO CLASS",!,"SURGICAL SERVICE",?22,"CLEAN",?31,"CONTAMINATED",?46,"CONTAMINATED",?61,"INFECTED",?73,"ENTERED"
- S SRHDR=1 W !
- Q
- END W:$E(IOST)="P" @IOF K ^TMP("SRT",$J),^TMP("SRTN",$J) I $D(ZTQUEUED) K ^TMP("SR",$J) 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
- SROWC1 ;B'HAM ISC/ADM - WOUND CLASSIFICATION REPORT (CONT.) ; [ 08/02/00 8:09 AM ]
- +1 ;;3.0; Surgery ;**50,95**;24 Jun 93
- +2 USE IO
- NEW SRFRTO
- SET Y=SRSD
- XECUTE ^DD("DD")
- SET SRFRTO="FROM: "_Y_" TO: "
- SET Y=SRED
- XECUTE ^DD("DD")
- SET SRFRTO=SRFRTO_Y
- SET SRSD=SRSD-.0001
- SET SRED=SRED+.9999
- SET Y=DT
- XECUTE ^DD("DD")
- SET SRPRINT="DATE PRINTED: "_Y
- +3 IF SRFLG=2
- GOTO ^SROWC2
- +4 IF SRFLG=3
- GOTO ^SROWC3
- +5 SET (SRHDR,SRSOUT,SRSS,SRCT)=0
- KILL ^TMP("SR",$JOB),^TMP("SRT",$JOB),^TMP("SRTN",$JOB)
- +6 IF 'SRSP
- DO ALL
- GOTO WC
- +7 IF SRSP
- DO SPEC
- GOTO WC
- +8 QUIT
- ALL FOR
- SET SRSS=$ORDER(^SRO(137.45,SRSS))
- IF 'SRSS
- QUIT
- SET ^TMP("SR",$JOB,SRSS)="0^0^0^0^0"
- +1 SET ^TMP("SR",$JOB,"ZZ")="0^0^0^0^0"
- +2 QUIT
- SPEC FOR
- SET SRSS=$ORDER(SRSP(SRSS))
- IF 'SRSS
- QUIT
- SET ^TMP("SR",$JOB,SRSS)="0^0^0^0^0"
- +1 QUIT
- WC SET ^TMP("SRT",$JOB)="0^0^0^0^0^0"
- SET SRCOMP=0
- +1 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 UTIL
- +2 DO HDR
- SET SRSS=""
- FOR
- SET SRSS=$ORDER(^TMP("SR",$JOB,SRSS))
- IF SRSS=""!(SRSOUT)
- QUIT
- SET SRCT=SRCT+1
- DO PRINT
- +3 DO TOTAL
- DO END
- +4 QUIT
- UTIL ; set ^TMP
- +1 IF $PIECE($GET(^SRF(SROP,30)),"^")'=""
- QUIT
- +2 IF $PIECE($GET(^SRF(SROP,.2)),"^",12)=""
- QUIT
- +3 SET SRSS=$PIECE(^SRF(SROP,0),"^",4)
- IF SRSS=""
- SET SRSS="ZZ"
- IF SRSP
- IF '$DATA(SRSP(SRSS))
- QUIT
- +4 SET SRWC=$PIECE($GET(^SRF(SROP,"1.0")),"^",8)
- SET SRP=$SELECT(SRWC="C":1,SRWC="CC":2,SRWC="D":3,SRWC="I":4,1:5)
- +5 SET $PIECE(^TMP("SR",$JOB,SRSS),"^",SRP)=$PIECE(^TMP("SR",$JOB,SRSS),"^",SRP)+1
- IF SRP=5
- SET ^TMP("SRTN",$JOB,SRSS,SRSD,SROP)=""
- +6 SET $PIECE(^TMP("SRT",$JOB),"^",SRP)=$PIECE(^TMP("SRT",$JOB),"^",SRP)+1
- SET $PIECE(^TMP("SRT",$JOB),"^",6)=$PIECE(^TMP("SRT",$JOB),"^",6)+1
- +7 IF SRP=1
- 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
- +8 IF SRP=1
- IF SRIN
- SET SRCOMP=SRCOMP+1
- +9 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 SET Y=^TMP("SR",$JOB,SRSS)
- SET SRC=$PIECE(Y,"^")
- SET SRCC=$PIECE(Y,"^",2)
- SET SRD=$PIECE(Y,"^",3)
- SET SRI=$PIECE(Y,"^",4)
- SET SRZZ=$PIECE(Y,"^",5)
- +4 IF 'SRSP
- IF '(SRC+SRCC+SRD+SRI+SRZZ)
- QUIT
- +5 WRITE !,$PIECE(SRSPEC,"("),?21,$JUSTIFY(SRC,5),?33,$JUSTIFY(SRCC,5),?47,$JUSTIFY(SRD,5),?61,$JUSTIFY(SRI,5),?73,$JUSTIFY(SRZZ,5)
- +6 QUIT
- TOTAL ; print totals
- +1 IF SRSOUT
- QUIT
- IF $Y+8>IOSL
- DO HDR
- IF SRSOUT
- QUIT
- +2 SET Y=^TMP("SRT",$JOB)
- SET SRC=$PIECE(Y,"^")
- SET SRCC=$PIECE(Y,"^",2)
- SET SRD=$PIECE(Y,"^",3)
- SET SRI=$PIECE(Y,"^",4)
- SET SRZZ=$PIECE(Y,"^",5)
- SET SRT=$PIECE(Y,"^",6)
- +3 IF SRCT>1
- WRITE !!,"SUB TOTAL:",?21,$JUSTIFY(SRC,5),?33,$JUSTIFY(SRCC,5),?47,$JUSTIFY(SRD,5),?61,$JUSTIFY(SRI,5),?73,$JUSTIFY(SRZZ,5)
- +4 WRITE !!,"TOTAL: ",SRT
- IF SRC=0
- SET SRC=1
- WRITE !!,"CLEAN WOUND INFECTION RATE: ",$JUSTIFY((SRCOMP/SRC*100),5,1),"%"
- +5 QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 IF $EXTRACT(IOST)'="P"
- DO HDR1
- QUIT
- +3 IF $Y
- WRITE @IOF
- WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE",!,?26,"WOUND CLASSIFICATION REPORT",!,?(80-$LENGTH(SRFRTO)\2),SRFRTO,!,?(80-$LENGTH(SRPRINT)\2),SRPRINT
- +4 WRITE !,?21,"REVIEWED BY:",?45,"DATE REVIEWED:",!
- +5 WRITE !,?34,"CLEAN",?72,"NO CLASS",!,"SURGICAL SERVICE",?22,"CLEAN",?31,"CONTAMINATED",?46,"CONTAMINATED",?61,"INFECTED",?73,"ENTERED"
- +6 WRITE !
- FOR LINE=1:1:80
- WRITE "="
- +7 WRITE !
- QUIT
- HDR1 ; print heading to screen
- +1 IF SRHDR
- WRITE !!,"Press RETURN to continue, or '^' to quit: "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET SRSOUT=1
- QUIT
- +2 WRITE @IOF,!,?26,"WOUND CLASSIFICATION REPORT",!,?(80-$LENGTH(SRFRTO)\2),SRFRTO
- +3 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +4 WRITE !!,?34,"CLEAN",?72,"NO CLASS",!,"SURGICAL SERVICE",?22,"CLEAN",?31,"CONTAMINATED",?46,"CONTAMINATED",?61,"INFECTED",?73,"ENTERED"
- +5 SET SRHDR=1
- WRITE !
- +6 QUIT
- END IF $EXTRACT(IOST)="P"
- WRITE @IOF
- KILL ^TMP("SRT",$JOB),^TMP("SRTN",$JOB)
- IF $DATA(ZTQUEUED)
- KILL ^TMP("SR",$JOB)
- 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
