SROCMP1 ;BIR/MAM - PERIOPERATIVE OCCURRENCES ;02/02/06
;;3.0;Surgery;**38,50,153,175**;24 Jun 93;Build 6
EN ; entry point
N SRSEL S (SRATT,SRSOUT,SRSP)=0,SRSEL=1 G:SRBOTH DEV
BY W @IOF K DIR S DIR(0)="N^1:3",DIR("A",1)="Print report by",DIR("A",2)=" 1. Surgical Specialty"
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
S DIR("?")="Select a number" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
S SRSEL=Y
I SRSEL=2 D ATTND Q
I SRSEL=3 D OCC Q
SPEC W @IOF K DIR S DIR("A")="Do you want to print this report for all Surgical Specialties ",DIR("B")="YES",DIR(0)="Y"
S DIR("?",1)=" Press ENTER to print this report for all surgical specialties, or"
S DIR("?")=" enter NO to select a specific specialty."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
I 'Y D SP I SRSOUT D END Q
DEV S SRGRAMM=$S(SRBOTH:"These reports are ",1:"This report is ")
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
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
D BEG^SROCMP
END ;
Q:'$D(SRSOUT) I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
D ^%ZISC,^SRSKILL K SRTN W @IOF
Q
ATTND W @IOF K DIR S DIR("A")="Do you want to print this report for all Attending Surgeons ",DIR("B")="YES",DIR(0)="Y"
S DIR("?",1)=" Press ENTER to print this report for all attending surgeons, or"
S DIR("?")=" enter NO to select a specific attending surgeon."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
I 'Y D ATSUR I SRSOUT D END Q
D DEV
Q
ATSUR W !! S SRSP=1 K DIR S DIR(0)="130,.164AO",DIR("A")="Print the report for which Attending Surgeon ? "
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(+Y'>0) S SRSOUT=1 Q
S SRCT=+Y,SRSP(SRCT)=+Y
MOAT ; ask for more attending surgeons
K DIR S DIR(0)="130,.164AO",DIR("A")="Select an Additional Attending Surgeon: "
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'+Y Q
S SRCT=+Y,SRSP(SRCT)=+Y G MOAT
Q
OCC W @IOF K DIR S DIR("A")="Do you want to print this report for all Occurrence Categories",DIR("B")="YES",DIR(0)="Y"
S DIR("?",1)=" Press ENTER to print this report for all occurrence categoies, or"
S DIR("?")=" enter NO to select an occurrence category."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
I 'Y D CAT I SRSOUT D END Q
D DEV
Q
CAT W !! S SRSP=1 K DIR S DIR(0)="PAO^136.5:QEM",DIR("A")="Print the report for which Occurrence Category ? "
S DIR("S")="I '$P(^(0),U,2)" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(+Y'>0) S SRSOUT=1 Q
S SRCT=+Y,SRSP(SRCT)=+Y
MOCAT ; ask for more occurrence categories
K DIR S DIR(0)="PAO^136.5:QEM",DIR("A")="Select an Additional Occurrence Category: "
S DIR("S")="I '$P(^(0),U,2)" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(+Y'>0) Q
S SRCT=+Y,SRSP(SRCT)=+Y G MOCAT
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCMP1 3467 printed Sep 23, 2025@20:19:11 Page 2
SROCMP1 ;BIR/MAM - PERIOPERATIVE OCCURRENCES ;02/02/06
+1 ;;3.0;Surgery;**38,50,153,175**;24 Jun 93;Build 6
EN ; entry point
+1 NEW SRSEL
SET (SRATT,SRSOUT,SRSP)=0
SET SRSEL=1
if SRBOTH
GOTO DEV
BY WRITE @IOF
KILL DIR
SET DIR(0)="N^1:3"
SET DIR("A",1)="Print report by"
SET DIR("A",2)=" 1. Surgical Specialty"
+1 SET DIR("A",3)=" 2. Attending Surgeon"
SET DIR("A",4)=" 3. Occurrence Category"
SET DIR("A",5)=""
SET DIR("A")="Select 1, 2 or 3"
SET DIR("B")=1
+2 SET DIR("?")="Select a number"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
DO END
QUIT
+3 SET SRSEL=Y
+4 IF SRSEL=2
DO ATTND
QUIT
+5 IF SRSEL=3
DO OCC
QUIT
SPEC WRITE @IOF
KILL DIR
SET DIR("A")="Do you want to print this report for all Surgical Specialties "
SET DIR("B")="YES"
SET DIR(0)="Y"
+1 SET DIR("?",1)=" Press ENTER to print this report for all surgical specialties, or"
+2 SET DIR("?")=" enter NO to select a specific specialty."
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
DO END
QUIT
+4 IF 'Y
DO SP
IF SRSOUT
DO END
QUIT
DEV SET SRGRAMM=$SELECT(SRBOTH:"These reports are ",1:"This report is ")
+1 KILL IOP,%ZIS,POP,IO("Q")
SET %ZIS("A")="Print the Report on which Device: "
SET %ZIS="QM"
WRITE !!,SRGRAMM_"designed to use a 132 column format.",!
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+2 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="PERIOPERATIVE OCCURRENCES"
SET ZTRTN="BEG^SROCMP"
SET (ZTSAVE("SRBOTH*"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRSP*"),ZTSAVE("SRSEL"))=""
DO ^%ZTLOAD
GOTO END
+3 DO BEG^SROCMP
END ;
+1 if '$DATA(SRSOUT)
QUIT
IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+2 DO ^%ZISC
DO ^SRSKILL
KILL SRTN
WRITE @IOF
+3 QUIT
ATTND WRITE @IOF
KILL DIR
SET DIR("A")="Do you want to print this report for all Attending Surgeons "
SET DIR("B")="YES"
SET DIR(0)="Y"
+1 SET DIR("?",1)=" Press ENTER to print this report for all attending surgeons, or"
+2 SET DIR("?")=" enter NO to select a specific attending surgeon."
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
DO END
QUIT
+4 IF 'Y
DO ATSUR
IF SRSOUT
DO END
QUIT
+5 DO DEV
+6 QUIT
ATSUR WRITE !!
SET SRSP=1
KILL DIR
SET DIR(0)="130,.164AO"
SET DIR("A")="Print the report for which Attending Surgeon ? "
+1 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!(+Y'>0)
SET SRSOUT=1
QUIT
+2 SET SRCT=+Y
SET SRSP(SRCT)=+Y
MOAT ; ask for more attending surgeons
+1 KILL DIR
SET DIR(0)="130,.164AO"
SET DIR("A")="Select an Additional Attending Surgeon: "
+2 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'+Y
QUIT
+3 SET SRCT=+Y
SET SRSP(SRCT)=+Y
GOTO MOAT
+4 QUIT
OCC WRITE @IOF
KILL DIR
SET DIR("A")="Do you want to print this report for all Occurrence Categories"
SET DIR("B")="YES"
SET DIR(0)="Y"
+1 SET DIR("?",1)=" Press ENTER to print this report for all occurrence categoies, or"
+2 SET DIR("?")=" enter NO to select an occurrence category."
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
DO END
QUIT
+4 IF 'Y
DO CAT
IF SRSOUT
DO END
QUIT
+5 DO DEV
+6 QUIT
CAT WRITE !!
SET SRSP=1
KILL DIR
SET DIR(0)="PAO^136.5:QEM"
SET DIR("A")="Print the report for which Occurrence Category ? "
+1 SET DIR("S")="I '$P(^(0),U,2)"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!(+Y'>0)
SET SRSOUT=1
QUIT
+2 SET SRCT=+Y
SET SRSP(SRCT)=+Y
MOCAT ; ask for more occurrence categories
+1 KILL DIR
SET DIR(0)="PAO^136.5:QEM"
SET DIR("A")="Select an Additional Occurrence Category: "
+2 SET DIR("S")="I '$P(^(0),U,2)"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!(+Y'>0)
QUIT
+3 SET SRCT=+Y
SET SRSP(SRCT)=+Y
GOTO MOCAT
+4 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
