source: WorldVistAEHR/trunk/r/SURGERY-SR/SROWC.m@ 1450

Last change on this file since 1450 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1SROWC ;B'HAM ISC/ADM - WOUND CLASSIFICATION REPORT ; [ 09/22/98 11:36 AM ]
2 ;;3.0; Surgery ;**77,50**;24 Jun 93
3 S (SRSOUT,SRSP)=0
4 W @IOF,!,"Wound Classification Report",!
5DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END
6 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))
7RPT W @IOF,!,"Print which of the following ?",!!,"1. Wound Classification Report (Summary)",!,"2. List of Operations by Wound Classification",!,"3. Clean Wound Infection Summary"
8 W !!,"Select Number: 1// " R X:DTIME I '$T!(X["^") G END
9 S:X="" X=1 I X>3!(X<1)!(X'?.N) D HELP G:SRSOUT END G RPT
10 S SRFLG=X I SRFLG=2 G CLASS
11SPEC W !!!,"Do you want to print the report for all Surgical Specialties ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
12 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
13 I "YyNn"'[SRYN W !!,"Enter RETURN to print this report for all surgical specialties, or 'NO' to",!,"select a specific specialty." G SPEC
14 I "Nn"[SRYN D SP I SRSOUT G END
15DEVICE W ! K IOP,%ZIS,POP,IO("Q") S %ZIS="QM",%ZIS("A")="Print on Device: " D ^%ZIS I POP S SRSOUT=1 G END
16 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
17 G ^SROWC1
18 Q
19SP 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
20 S SRCT=+Y,SRSP(SRCT)=+Y
21MORE ; ask for more surgical specialties
22 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
23 Q
24END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
25 D ^%ZISC,^SRSKILL W @IOF
26 Q
27HELP W !!,"Enter '1' or press RETURN to print the Wound Classification Report",!,"which summarizes wound classifications entered for surgical cases performed"
28 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. "
29 W "Enter '3' to print the summary of clean wound",!,"infections."
30 W !!,"Press RETURN to continue, or '^' to quit. " R X:DTIME I '$T!(X["^") S SRSOUT=1
31 Q
32CLASS W !!!,"Do you want to print the report for all Wound Classifications ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
33 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
34 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
35 I "Yy"[SRYN S SRCLASS="ALL" G SPEC
36 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
37 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
38 S SRCLASS=SRCODE(Y) G SPEC
39 Q
40CLIST ; get list of wound classifications
41 N SRLIST,SRC,SRP,J,X,Y,Z D HELP^DIE(130,"",1.09,"S","SRLIST")
42 S Z=1 F I=2:1:SRLIST("DIHELP") D S Z=Z+1
43 .S X=SRLIST("DIHELP",I),Y=$F(X," "),SRC=$E(X,1,Y-2),SRCODE(Z)=SRC
44 .F J=Y:1 I $E(X,J)'=" " S SRP=$E(X,J,99),SRWC(Z)=SRP Q
45 S SRCODE(Z)="",SRWC(Z)="NO CLASS ENTERED"
46 Q
Note: See TracBrowser for help on using the repository browser.