source: WorldVistAEHR/trunk/r/SURGERY-SR/SROCMP1.m@ 1093

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1SROCMP1 ;BIR/MAM - PERIOPERATIVE OCCURRENCES ;02/02/06
2 ;;3.0; Surgery ;**38,50,153**;24 Jun 93;Build 11
3EN ; entry point
4 N SRSEL S (SRATT,SRSOUT,SRSP)=0,SRSEL=1 G:SRBOTH DEV
5BY W @IOF K DIR S DIR(0)="N^1:3",DIR("A",1)="Print report by",DIR("A",2)=" 1. Surgical Specialty"
6 S DIR("A",3)=" 2. Attending Surgeon",DIR("A",4)=" 3. Occurrence Category",DIR("A",5)="",DIR("A")="Select 1, 2 or 3",DIR("B")=1
7 S DIR("?")="Select a number" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
8 S SRSEL=Y
9 I SRSEL=2 D ATTND Q
10 I SRSEL=3 D OCC Q
11SPEC W @IOF K DIR S DIR("A")="Do you want to print this report for all Surgical Specialties ",DIR("B")="YES",DIR(0)="Y"
12 S DIR("?",1)=" Press ENTER to print this report for all surgical specialties, or"
13 S DIR("?")=" enter NO to select a specific specialty."
14 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
15 I 'Y D SP I SRSOUT D END Q
16DEV S SRGRAMM=$S(SRBOTH:"These reports are ",1:"This report is ")
17 K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,SRGRAMM_"designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 G END
18 I $D(IO("Q")) K IO("Q") S ZTDESC="PERIOPERATIVE OCCURRENCES",ZTRTN="BEG^SROCMP",(ZTSAVE("SRBOTH"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRSP*"),ZTSAVE("SRSEL"))="" D ^%ZTLOAD G END
19 D BEG^SROCMP
20END ;
21 Q:'$D(SRSOUT) I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
22 D ^%ZISC,^SRSKILL K SRTN W @IOF
23 Q
24ATTND W @IOF K DIR S DIR("A")="Do you want to print this report for all Attending Surgeons ",DIR("B")="YES",DIR(0)="Y"
25 S DIR("?",1)=" Press ENTER to print this report for all attending surgeons, or"
26 S DIR("?")=" enter NO to select a specific attending surgeon."
27 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
28 I 'Y D ATSUR I SRSOUT D END Q
29 D DEV
30 Q
31ATSUR W !! S SRSP=1 K DIR S DIR(0)="130,.164AO",DIR("A")="Print the report for which Attending Surgeon ? "
32 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(+Y'>0) S SRSOUT=1 Q
33 S SRCT=+Y,SRSP(SRCT)=+Y
34MOAT ; ask for more attending surgeons
35 K DIR S DIR(0)="130,.164AO",DIR("A")="Select an Additional Attending Surgeon: "
36 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'+Y Q
37 S SRCT=+Y,SRSP(SRCT)=+Y G MOAT
38 Q
39OCC W @IOF K DIR S DIR("A")="Do you want to print this report for all Occurrence Categories",DIR("B")="YES",DIR(0)="Y"
40 S DIR("?",1)=" Press ENTER to print this report for all occurrence categoies, or"
41 S DIR("?")=" enter NO to select an ocurrence category."
42 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
43 I 'Y D CAT I SRSOUT D END Q
44 D DEV
45 Q
46CAT W !! S SRSP=1 K DIR S DIR(0)="PAO^136.5:QEM",DIR("A")="Print the report for which Occurrence Category ? "
47 S DIR("S")="I '$P(^(0),U,2)" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(+Y'>0) S SRSOUT=1 Q
48 S SRCT=+Y,SRSP(SRCT)=+Y
49MOCAT ; ask for more occurrence categories
50 K DIR S DIR(0)="PAO^136.5:QEM",DIR("A")="Select an Additional Occurrence Category: "
51 S DIR("S")="I '$P(^(0),U,2)" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(+Y'>0) Q
52 S SRCT=+Y,SRSP(SRCT)=+Y G MOCAT
53 Q
54SP 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
55 S SRCT=+Y,SRSP(SRCT)=+Y
56MORE ; ask for more surgical specialties
57 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
58 Q
Note: See TracBrowser for help on using the repository browser.