SROWC1 ;BIR/ADM - WOUND CLASSIFICATION REPORT (CONT.) ;12/16/2010
;;3.0;Surgery;**50,95,175**;24 Jun 93;Build 6
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) 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 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROWC1 3540 printed Apr 09, 2024@21:48:46 Page 2
SROWC1 ;BIR/ADM - WOUND CLASSIFICATION REPORT (CONT.) ;12/16/2010
+1 ;;3.0;Surgery;**50,95,175**;24 Jun 93;Build 6
+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)
Begin DoDot:1
+8 IF SRCAT=1!(SRCAT=2)!(SRCAT=35)
SET SRIN=1
QUIT
+9 IF $PIECE($GET(^SRF(SROP,"RA")),"^",2)="C"
IF SRCAT=23!(SRCAT=25)
SET SRIN=1
End DoDot:1
+10 IF SRP=1
IF SRIN
SET SRCOMP=SRCOMP+1
+11 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
