SROPLST1.m

SROPLST1 ;B'HAM ISC/MAM - LIST OF OPERATIONS BY SERVICE; [ 09/22/98  11:36 AM ]

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

EN ; entry point

 W @IOF,!,"List of Operations sorted by Surgical Specialty",!!

DATE S (TC,SRSOUT)=0 D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END

 S SRD=SRSD-1

SEL W !!,"Do you want to print the report for all Specialties ?  YES// " R ANS:DTIME I '$T!(ANS["^") S SRSOUT=1 G END

 S ANS=$E(ANS) I "YyNn"'[ANS W !!,"Enter RETURN to print the report for all services, or 'N' to print the",!,"report for a specific surgical specialty." G SEL

 I "Yy"'[ANS W ! S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC("A")="Print the report for which Surgical Specialty ? ",DIC(0)="QEAMZ" D ^DIC G:Y'>0 END S SRTS=$P(Y(0),"^"),SRT1=+Y,SRZZ=1

 K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 G END

 I $D(SRZZ) I $D(IO("Q")) K IO("Q") S ZTDESC="LIST OF OPERATIONS",ZTRTN="2^SROPLSTS",(ZTSAVE("SRD"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRSITE*"),ZTSAVE("SRT1"),ZTSAVE("SRTS"))="" D ^%ZTLOAD G END

 I $D(IO("Q")) K IO("Q") S ZTDESC="LIST OF OPERATIONS",ZTRTN="1^SROPLSTS",(ZTSAVE("SRD"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRSITE*"))="",%ZIS="Q" D ^%ZTLOAD G END

 G 1^SROPLSTS

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

 W ! D ^SRSKILL W @IOF

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROPLST1   1415     printed  Apr 09, 2024@21:46                                                                                                                                                                                                       Page 2

SROPLST1  ;B'HAM ISC/MAM - LIST OF OPERATIONS BY SERVICE; [ 09/22/98  11:36 AM ]

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

EN        ; entry point

 +1        WRITE @IOF,!,"List of Operations sorted by Surgical Specialty",!!

DATE       SET (TC,SRSOUT)=0

           DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)

           if SRSOUT

               GOTO END

 +1        SET SRD=SRSD-1

SEL        WRITE !!,"Do you want to print the report for all Specialties ?  YES// "

           READ ANS:DTIME

           IF '$TEST!(ANS["^")

               SET SRSOUT=1

               GOTO END

 +1        SET ANS=$EXTRACT(ANS)

           IF "YyNn"'[ANS

               WRITE !!,"Enter RETURN to print the report for all services, or 'N' to print the",!,"report for a specific surgical specialty."

               GOTO SEL

 +2        IF "Yy"'[ANS

               WRITE !

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

               SET DIC=137.45

               SET DIC("A")="Print the report for which Surgical Specialty ? "

               SET DIC(0)="QEAMZ"

               DO ^DIC

               if Y'>0

                   GOTO END

               SET SRTS=$PIECE(Y(0),"^")

               SET SRT1=+Y

               SET SRZZ=1

 +3        KILL IOP,%ZIS,POP,IO("Q")

           SET %ZIS("A")="Print the Report on which Device: "

           SET %ZIS="QM"

           WRITE !!,"This report is designed to use a 132 column format.",!

           DO ^%ZIS

           IF POP

               SET SRSOUT=1

               GOTO END

 +4        IF $DATA(SRZZ)

               IF $DATA(IO("Q"))

                   KILL IO("Q")

                   SET ZTDESC="LIST OF OPERATIONS"

                   SET ZTRTN="2^SROPLSTS"

                   SET (ZTSAVE("SRD"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRSITE*"),ZTSAVE("SRT1"),ZTSAVE("SRTS"))=""

                   DO ^%ZTLOAD

                   GOTO END

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

               KILL IO("Q")

               SET ZTDESC="LIST OF OPERATIONS"

               SET ZTRTN="1^SROPLSTS"

               SET (ZTSAVE("SRD"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRSITE*"))=""

               SET %ZIS="Q"

               DO ^%ZTLOAD

               GOTO END

 +6        GOTO 1^SROPLSTS

END        IF $EXTRACT(IOST)'="P"

               IF 'SRSOUT

                   WRITE !!,"Press RETURN to continue  "

                   READ X:DTIME

 +1        WRITE !

           DO ^SRSKILL

           WRITE @IOF

 +2        QUIT