SROCMP1.m

SROCMP1 ;BIR/MAM - PERIOPERATIVE OCCURRENCES ;02/02/06

 ;;3.0; Surgery ;**38,50,153**;24 Jun 93;Build 11

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 ocurrence 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

SROCMP1   ;BIR/MAM - PERIOPERATIVE OCCURRENCES ;02/02/06

 +1       ;;3.0; Surgery ;**38,50,153**;24 Jun 93;Build 11

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 ocurrence 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