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 ---[H[J[2J[HSROWC 3441 printed Nov 22, 2024@17:56:35 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
