SROWC.m

SROWC ;B'HAM ISC/ADM - WOUND CLASSIFICATION REPORT ; [ 09/22/98  11:36 AM ]

 ;;3.0; Surgery ;**77,50**;24 Jun 93

 S (SRSOUT,SRSP)=0

 W @IOF,!,"Wound Classification Report",!

DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END

 N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))

RPT W @IOF,!,"Print which of the following ?",!!,"1.  Wound Classification Report (Summary)",!,"2.  List of Operations by Wound Classification",!,"3.  Clean Wound Infection Summary"

 W !!,"Select Number:  1// " R X:DTIME I '$T!(X["^") G END

 S:X="" X=1 I X>3!(X<1)!(X'?.N) D HELP G:SRSOUT END G RPT

 S SRFLG=X I SRFLG=2 G CLASS

SPEC W !!!,"Do you want to print the report for all Surgical Specialties ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END

 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"

 I "YyNn"'[SRYN W !!,"Enter RETURN to print this report for all surgical specialties, or 'NO' to",!,"select a specific specialty." G SPEC

 I "Nn"[SRYN D SP I SRSOUT G END

DEVICE W ! K IOP,%ZIS,POP,IO("Q") S %ZIS="QM",%ZIS("A")="Print on Device: " D ^%ZIS I POP S SRSOUT=1 G END

 I $D(IO("Q")) K IO("Q") S ZTDESC="WOUND CLASSIFICATION REPORT",ZTRTN="SROWC1",(ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRSP*"),ZTSAVE("SRFLG"),ZTSAVE("SRCLASS"))="" D ^%ZTLOAD G END

 G ^SROWC1

 Q

SP W !! S SRSP=1 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print the report for which Specialty ?  " D ^DIC I Y<0 S SRSOUT=1 Q

 S SRCT=+Y,SRSP(SRCT)=+Y

MORE ; ask for more surgical specialties

 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select An Additional Specialty:  " D ^DIC I Y>0 S SRCT=+Y,SRSP(SRCT)=+Y G MORE

 Q

END I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 D ^%ZISC,^SRSKILL W @IOF

 Q

HELP W !!,"Enter '1' or press RETURN to print the Wound Classification Report",!,"which summarizes wound classifications entered for surgical cases performed"

 W !,"during the selected date range.  Enter '2' to print the list of operations",!,"sorted by wound classification and by surgical specialty performed during",!,"the selected date range.  "

 W "Enter '3' to print the summary of clean wound",!,"infections."

 W !!,"Press RETURN to continue, or '^' to quit.  " R X:DTIME I '$T!(X["^") S SRSOUT=1

 Q

CLASS W !!!,"Do you want to print the report for all Wound Classifications ? YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END

 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"

 I "YyNn"'[SRYN W !!,"Enter RETURN to print this report for all wound classifications, or",!,"enter 'NO' to select a specific wound classification." G CLASS

 I "Yy"[SRYN S SRCLASS="ALL" G SPEC

 D CLIST W ! K DIR S DIR("A",1)="Print report for which Wound Classification ?",DIR("A",2)="" F Z=1:1 Q:'$D(SRWC(Z))  S DIR("A",Z+2)=Z_".  "_SRWC(Z),SRCNT=Z

 S Z=Z+2,DIR("A",Z)="",DIR("A")="Select Number:  ",DIR("?")="Enter a number between 1 and "_SRCNT_".",DIR(0)="NAO^1:"_SRCNT_":0" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRSOUT=1 G END

 S SRCLASS=SRCODE(Y) G SPEC

 Q

CLIST ; get list of wound classifications

 N SRLIST,SRC,SRP,J,X,Y,Z D HELP^DIE(130,"",1.09,"S","SRLIST")

 S Z=1 F I=2:1:SRLIST("DIHELP") D  S Z=Z+1

 .S X=SRLIST("DIHELP",I),Y=$F(X," "),SRC=$E(X,1,Y-2),SRCODE(Z)=SRC

 .F J=Y:1 I $E(X,J)'=" " S SRP=$E(X,J,99),SRWC(Z)=SRP Q

 S SRCODE(Z)="",SRWC(Z)="NO CLASS ENTERED"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROWC   3441     printed  Mar 13, 2025@21:51:48                                                                                                                                                                                                       Page 2

SROWC     ;B'HAM ISC/ADM - WOUND CLASSIFICATION REPORT ; [ 09/22/98  11:36 AM ]

 +1       ;;3.0; Surgery ;**77,50**;24 Jun 93

 +2        SET (SRSOUT,SRSP)=0

 +3        WRITE @IOF,!,"Wound Classification Report",!

DATE       DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)

           if SRSOUT

               GOTO END

 +1        NEW SRINSTP

           SET SRINST=$$INST^SROUTL0()

           if SRINST="^"

               GOTO END

           SET SRINSTP=$PIECE(SRINST,U)

           SET SRINST=$SELECT(SRINST["ALL DIVISIONS":SRINST,1:$PIECE(SRINST,U,2))

RPT        WRITE @IOF,!,"Print which of the following ?",!!,"1.  Wound Classification Report (Summary)",!,"2.  List of Operations by Wound Classification",!,"3.  Clean Wound Infection Summary"

 +1        WRITE !!,"Select Number:  1// "

           READ X:DTIME

           IF '$TEST!(X["^")

               GOTO END

 +2        if X=""

               SET X=1

           IF X>3!(X<1)!(X'?.N)

               DO HELP

               if SRSOUT

                   GOTO END

               GOTO RPT

 +3        SET SRFLG=X

           IF SRFLG=2

               GOTO CLASS

SPEC       WRITE !!!,"Do you want to print the report for all Surgical Specialties ?  YES//  "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               GOTO END

 +1        SET SRYN=$EXTRACT(SRYN)

           if SRYN=""

               SET SRYN="Y"

 +2        IF "YyNn"'[SRYN

               WRITE !!,"Enter RETURN to print this report for all surgical specialties, or 'NO' to",!,"select a specific specialty."

               GOTO SPEC

 +3        IF "Nn"[SRYN

               DO SP

               IF SRSOUT

                   GOTO END

DEVICE     WRITE !

           KILL IOP,%ZIS,POP,IO("Q")

           SET %ZIS="QM"

           SET %ZIS("A")="Print on Device: "

           DO ^%ZIS

           IF POP

               SET SRSOUT=1

               GOTO END

 +1        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTDESC="WOUND CLASSIFICATION REPORT"

               SET ZTRTN="SROWC1"

               SET (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRSP*"),ZTSAVE("SRFLG"),ZTSAVE("SRCLASS"))=""

               DO ^%ZTLOAD

               GOTO END

 +2        GOTO ^SROWC1

 +3        QUIT 

SP         WRITE !!

           SET SRSP=1

           KILL DIC

           SET DIC("S")="I '$P(^(0),""^"",3)"

           SET DIC=137.45

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Print the report for which Specialty ?  "

           DO ^DIC

           IF Y<0

               SET SRSOUT=1

               QUIT 

 +1        SET SRCT=+Y

           SET SRSP(SRCT)=+Y

MORE      ; ask for more surgical specialties

 +1        KILL DIC

           SET DIC("S")="I '$P(^(0),""^"",3)"

           SET DIC=137.45

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select An Additional Specialty:  "

           DO ^DIC

           IF Y>0

               SET SRCT=+Y

               SET SRSP(SRCT)=+Y

               GOTO MORE

 +2        QUIT 

END        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +1        DO ^%ZISC

           DO ^SRSKILL

           WRITE @IOF

 +2        QUIT 

HELP       WRITE !!,"Enter '1' or press RETURN to print the Wound Classification Report",!,"which summarizes wound classifications entered for surgical cases performed"

 +1        WRITE !,"during the selected date range.  Enter '2' to print the list of operations",!,"sorted by wound classification and by surgical specialty performed during",!,"the selected date range.  "

 +2        WRITE "Enter '3' to print the summary of clean wound",!,"infections."

 +3        WRITE !!,"Press RETURN to continue, or '^' to quit.  "

           READ X:DTIME

           IF '$TEST!(X["^")

               SET SRSOUT=1

 +4        QUIT 

CLASS      WRITE !!!,"Do you want to print the report for all Wound Classifications ? YES//  "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               GOTO END

 +1        SET SRYN=$EXTRACT(SRYN)

           if SRYN=""

               SET SRYN="Y"

 +2        IF "YyNn"'[SRYN

               WRITE !!,"Enter RETURN to print this report for all wound classifications, or",!,"enter 'NO' to select a specific wound classification."

               GOTO CLASS

 +3        IF "Yy"[SRYN

               SET SRCLASS="ALL"

               GOTO SPEC

 +4        DO CLIST

           WRITE !

           KILL DIR

           SET DIR("A",1)="Print report for which Wound Classification ?"

           SET DIR("A",2)=""

           FOR Z=1:1

               if '$DATA(SRWC(Z))

                   QUIT 

               SET DIR("A",Z+2)=Z_".  "_SRWC(Z)

               SET SRCNT=Z

 +5        SET Z=Z+2

           SET DIR("A",Z)=""

           SET DIR("A")="Select Number:  "

           SET DIR("?")="Enter a number between 1 and "_SRCNT_"."

           SET DIR(0)="NAO^1:"_SRCNT_":0"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)!'Y

               SET SRSOUT=1

               GOTO END

 +6        SET SRCLASS=SRCODE(Y)

           GOTO SPEC

 +7        QUIT 

CLIST     ; get list of wound classifications

 +1        NEW SRLIST,SRC,SRP,J,X,Y,Z

           DO HELP^DIE(130,"",1.09,"S","SRLIST")

 +2        SET Z=1

           FOR I=2:1:SRLIST("DIHELP")

               Begin DoDot:1

 +3                SET X=SRLIST("DIHELP",I)

                   SET Y=$FIND(X," ")

                   SET SRC=$EXTRACT(X,1,Y-2)

                   SET SRCODE(Z)=SRC

 +4                FOR J=Y:1

                       IF $EXTRACT(X,J)'=" "

                           SET SRP=$EXTRACT(X,J,99)

                           SET SRWC(Z)=SRP

                           QUIT 

               End DoDot:1

               SET Z=Z+1

 +5        SET SRCODE(Z)=""

           SET SRWC(Z)="NO CLASS ENTERED"

 +6        QUIT