Routine: SRSWL4

SRSWL4 ;B'HAM ISC/MAM - WAITING LIST, EXTENDED-ONE SPECIALTY ; 17 OCT 1989  7:35 AM [ 09/12/94  1:00 PM ]

 ;;3.0; Surgery ;**34**;24 Jun 93

 W ! K %ZIS,POP,IOP,IO("Q") S %ZIS("A")="Print the Waiting List on which Device: ",%ZIS="Q" D ^%ZIS Q:POP

 I $D(IO("Q")) K IO("Q") S ZTDESC="SURGERY WAITING LIST",ZTRTN="BEG^SRSWL4",(ZTSAVE("SRSS"),ZTSAVE("SRSNM"))="" D ^%ZTLOAD G END

BEG ; entry when queued

 U IO S SRSOUT=0 D NOW^%DTC S Y=% D D^DIQ S SRTIME=$E(Y,1,12)_" at "_$E(Y,14,18) D HDR

 S SRSDT=0 F  S SRSDT=$O(^SRO(133.8,"AWL",SRSS,SRSDT)) Q:'SRSDT!(SRSOUT)  S SROFN=0 F  S SROFN=$O(^SRO(133.8,"AWL",SRSS,SRSDT,SROFN)) Q:'SROFN!(SRSOUT)  D PRINT

END I $E(IOST)="P" S SRSOUT=1 W @IOF

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

 I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME W @IOF

 D ^%ZISC,^SRSKILL K SRTN

HDR ; print heading

 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q

 W:$Y @IOF W !,"Surgery Waiting List for "_SRSNM,!,"Printed "_SRTIME,! F LINE=1:1:80 W "="

PRINT ; print information

 I $Y+20>IOSL D PAGE Q:SRSOUT

 S SRW=^SRO(133.8,SRSS,1,SROFN,0),DFN=$P(SRW,"^") D DEM^VADPT S SRSDPT=VADM(1)_" ("_VA("PID")_")",SROPER=$P(SRW,"^",2),Y=SRSDT D D^DIQ S SRDT=$E(Y,1,12)_" "_$E(Y,14,18)

 D OUT^SRSWL3

LOOP ; break operation if greater than 59 characters

 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM=""  Q:$L(SROPS(M))+$L(MM)'<59  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM

PAGE ; end of page

 I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit:  " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

 D HDR

SRSWL4    ;B'HAM ISC/MAM - WAITING LIST, EXTENDED-ONE SPECIALTY ; 17 OCT 1989  7:35 AM [ 09/12/94  1:00 PM ]

 +1       ;;3.0; Surgery ;**34**;24 Jun 93

 +2        WRITE !

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

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

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               QUIT

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

               KILL IO("Q")

               SET ZTDESC="SURGERY WAITING LIST"

               SET ZTRTN="BEG^SRSWL4"

               SET (ZTSAVE("SRSS"),ZTSAVE("SRSNM"))=""

               DO ^%ZTLOAD

               GOTO END

BEG       ; entry when queued

 +1        USE IO

           SET SRSOUT=0

           DO NOW^%DTC

           SET Y=%

           DO D^DIQ

           SET SRTIME=$EXTRACT(Y,1,12)_" at "_$EXTRACT(Y,14,18)

           DO HDR

 +2        SET SRSDT=0

FOR

               SET SRSDT=$ORDER(^SRO(133.8,"AWL",SRSS,SRSDT))

               IF 'SRSDT!(SRSOUT)

                   QUIT

               SET SROFN=0

FOR

                   SET SROFN=$ORDER(^SRO(133.8,"AWL",SRSS,SRSDT,SROFN))

                   IF 'SROFN!(SRSOUT)

                       QUIT

                   DO PRINT

END        IF $EXTRACT(IOST)="P"

               SET SRSOUT=1

               WRITE @IOF

 +1        IF $DATA(ZTQUEUED)

               KILL ^TMP("SR",$JOB)

               IF $GET(ZTSTOP)

                   QUIT

               SET ZTREQ="@"

               QUIT

 +2        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

               WRITE @IOF

 +3        DO ^%ZISC

           DO ^SRSKILL

           KILL SRTN

 +4        QUIT

HDR       ; print heading

 +1        IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT

 +2        IF $Y

               WRITE @IOF

           WRITE !,"Surgery Waiting List for "_SRSNM,!,"Printed "_SRTIME,!

           FOR LINE=1:1:80

               WRITE "="

 +3        QUIT

PRINT     ; print information

 +1        IF $Y+20>IOSL

               DO PAGE

               IF SRSOUT

                   QUIT

 +2        SET SRW=^SRO(133.8,SRSS,1,SROFN,0)

           SET DFN=$PIECE(SRW,"^")

           DO DEM^VADPT

           SET SRSDPT=VADM(1)_" ("_VA("PID")_")"

           SET SROPER=$PIECE(SRW,"^",2)

           SET Y=SRSDT

           DO D^DIQ

           SET SRDT=$EXTRACT(Y,1,12)_" "_$EXTRACT(Y,14,18)

 +3        DO OUT^SRSWL3

 +4        QUIT

LOOP      ; break operation if greater than 59 characters

 +1        SET SROPS(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

               SET MMM=$PIECE(SROPER," ",2,200)

               IF MMM=""

                   QUIT

               IF $LENGTH(SROPS(M))+$LENGTH(MM)'<59

                   QUIT

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT

PAGE      ; end of page

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

               WRITE !!,"Press RETURN to continue, or '^' to quit:  "

               READ X:DTIME

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

                   SET SRSOUT=1

                   QUIT

 +2        DO HDR

 +3        QUIT

SRSWL4.m