SROAR.m

SROAR ;B'HAM ISC/MAM - ANNUAL REPORT OF SURGICAL PROCEDURES ; [ 09/22/98  11:28 AM ]

 ;;3.0; Surgery ;**77,50**;24 Jun 93

BEG S SRSOUT=0

 W @IOF,!,"Annual Report of Surgical Procedures"

DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END

ALL W !!,"Do you want to print the Annual Report of Surgical Procedures 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 if you want to print the report for all specialties, or 'NO'",!,"to select a specific Surgical Specialty.",!!,"Press RETURN to continue  " R X:DTIME G ALL

 S SRSS="ALL" I "Nn"[SRYN W !! K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print the Annual Report for which Specialty ?  " D ^DIC S:Y<0 SRSOUT=1 G:Y<0 END S SRSS=+Y

 W !!,"This report is designed to use a 132 column format, and must be run",!,"on a printer.",!!

PTR K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Select Printer: ",%ZIS="QM" D ^%ZIS I POP S SRSOUT=1 G END

 I $E(IOST)'="P" W !!,"This report must be run on a printer.  Please select another device.",! D PRESS G:SRSOUT END D ^%ZISC W @IOF G PTR

 I $D(IO("Q")) K IO("Q") S ZTRTN="EN^SROAR",(ZTSAVE("SDATE"),ZTSAVE("EDATE"),ZTSAVE("SRSS"),ZTSAVE("SRSITE*"))="",ZTDESC="ANNUAL REPORT OF SURGICAL PROCEDURES" D ^%ZTLOAD G END

EN U IO N SRFRTO S Y=SDATE X ^DD("DD") S SRFRTO="FROM: "_Y_"  TO: ",Y=EDATE X ^DD("DD") S SRFRTO=SRFRTO_Y,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y

 S SDATE1=SDATE-.0001,EDATE1=EDATE+.9999,SRINST=SRSITE("SITE"),SRHALT=0,SRSOUT=1 I SRSS="ALL" D ^SROAR1 G END

 D ^SROAR2

END W ! I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue  " R X:DTIME

 W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP)  S ZTREQ="@" Q

 D ^%ZISC W @IOF K SRTN D ^SRSKILL

 Q

PRESS W ! K DIR  S DIR("A")="  Press RETURN to continue or '^' to quit. ",DIR(0)="FOA" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROAR   1958     printed  Apr 09, 2024@21:44:03                                                                                                                                                                                                       Page 2

SROAR     ;B'HAM ISC/MAM - ANNUAL REPORT OF SURGICAL PROCEDURES ; [ 09/22/98  11:28 AM ]

 +1       ;;3.0; Surgery ;**77,50**;24 Jun 93

BEG        SET SRSOUT=0

 +1        WRITE @IOF,!,"Annual Report of Surgical Procedures"

DATE       DO DATE^SROUTL(.SDATE,.EDATE,.SRSOUT)

           if SRSOUT

               GOTO END

ALL        WRITE !!,"Do you want to print the Annual Report of Surgical Procedures 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 if you want to print the report for all specialties, or 'NO'",!,"to select a specific Surgical Specialty.",!!,"Press RETURN to continue  "

               READ X:DTIME

               GOTO ALL

 +3        SET SRSS="ALL"

           IF "Nn"[SRYN

               WRITE !!

               KILL DIC

               SET DIC("S")="I '$P(^(0),""^"",3)"

               SET DIC=137.45

               SET DIC(0)="QEAMZ"

               SET DIC("A")="Print the Annual Report for which Specialty ?  "

               DO ^DIC

               if Y<0

                   SET SRSOUT=1

               if Y<0

                   GOTO END

               SET SRSS=+Y

 +4        WRITE !!,"This report is designed to use a 132 column format, and must be run",!,"on a printer.",!!

PTR        KILL IOP,%ZIS,POP,IO("Q")

           SET %ZIS("A")="Select Printer: "

           SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               SET SRSOUT=1

               GOTO END

 +1        IF $EXTRACT(IOST)'="P"

               WRITE !!,"This report must be run on a printer.  Please select another device.",!

               DO PRESS

               if SRSOUT

                   GOTO END

               DO ^%ZISC

               WRITE @IOF

               GOTO PTR

 +2        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="EN^SROAR"

               SET (ZTSAVE("SDATE"),ZTSAVE("EDATE"),ZTSAVE("SRSS"),ZTSAVE("SRSITE*"))=""

               SET ZTDESC="ANNUAL REPORT OF SURGICAL PROCEDURES"

               DO ^%ZTLOAD

               GOTO END

EN         USE IO

           NEW SRFRTO

           SET Y=SDATE

           XECUTE ^DD("DD")

           SET SRFRTO="FROM: "_Y_"  TO: "

           SET Y=EDATE

           XECUTE ^DD("DD")

           SET SRFRTO=SRFRTO_Y

           SET Y=DT

           XECUTE ^DD("DD")

           SET SRPRINT="DATE PRINTED: "_Y

 +1        SET SDATE1=SDATE-.0001

           SET EDATE1=EDATE+.9999

           SET SRINST=SRSITE("SITE")

           SET SRHALT=0

           SET SRSOUT=1

           IF SRSS="ALL"

               DO ^SROAR1

               GOTO END

 +2        DO ^SROAR2

END        WRITE !

           IF 'SRSOUT

               IF $EXTRACT(IOST)'="P"

                   WRITE !!,"Press RETURN to continue  "

                   READ X:DTIME

 +1        if $EXTRACT(IOST)="P"

               WRITE @IOF

           IF $DATA(ZTQUEUED)

               KILL ^TMP("SR",$JOB)

               if $GET(ZTSTOP)

                   QUIT 

               SET ZTREQ="@"

               QUIT 

 +2        DO ^%ZISC

           WRITE @IOF

           KILL SRTN

           DO ^SRSKILL

 +3        QUIT 

PRESS      WRITE !

           KILL DIR

           SET DIR("A")="  Press RETURN to continue or '^' to quit. "

           SET DIR(0)="FOA"

           DO ^DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

 +1        QUIT