SRSWL10.m

SRSWL10 ;B'HAM ISC/MAM - WAITING LIST, BRIEF-ALL ; 17 OCT 1989  7:35 AM

 ;;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^SRSWL10" D ^%ZTLOAD G END

BEG ; entry when queued

 K ^TMP("SR",$J)

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

 ;

 D HDR

 S SS="",ST="",SR="",SRW="",SRNAME="",SRRECNO="",SRSUB="",DFN="",SRSDPT=""

 ;

 F  S SRW=$O(^SRO(133.8,"AP",SRW)) Q:SRW=""  F  S SRRECNO=$O(^SRO(133.8,"AP",SRW,SRRECNO)) Q:SRRECNO=""  F  S SRSUB=$O(^SRO(133.8,"AP",SRW,SRRECNO,SRSUB)) Q:SRSUB=""  D MORE

 ;

 F  S SS=$O(^TMP("SR",$J,SS)) Q:SS=""!(SRSOUT)  F  S SR=$O(^TMP("SR",$J,SS,SR)) Q:SR=""!(SRSOUT)  F  S ST=$O(^TMP("SR",$J,SS,SR,ST)) Q:ST=""!(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

 Q

PRINT ; print information

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

 ;

 S SRSDPT=SS,SRSS=SR,SROFN=ST

 ;

 S SRW=^SRO(133.8,SRSS,1,SROFN,0),DFN=$P(SRW,"^"),SROPER=$P(SRW,"^",2),Y=$P(SRW,"^",3) D D^DIQ S SRDT=$E(Y,1,12)

 ;

 S Y=$P(SRW,"^",4) S:Y="" SRADT="" I Y D D^DIQ S SRADT=$E(Y,1,12)

 ;

 S (Y,SROPDT)=$P(SRW,"^",5) I Y D D^DIQ S SROPDT=Y

 ;

 S SRSDPT=$S($L(SRSDPT)<24:SRSDPT,1:$E(SRSDPT,1,23))

 ;

 K SROP,MM,MMM S:$L(SROPER)<40 SROP(1)=SROPER I $L(SROPER)>39 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 ;

 W !,SRDT,?15,SRSDPT,?40,SROP(1),!,"Tentative Admission: "_SRADT I $D(SROP(2)) W ?40,SROP(2)

 ;

 I SROPDT="" S SROPDT="None Specified"

 W !,"Tentative Date of Operation: "_SROPDT

 ;

 S SRNAME=$P(^SRO(133.8,SRSS,0),"^"),SRNAME=$P(^SRO(137.45,SRNAME,0),"^")

 ;

 S SROLD=0 D OLD^SRSWLST I SROLD W !,"* Procedure performed since entry on list ("_SROLD("DATE")_")"

 ;

 W ! F LINE=1:1:80 W "-"

 Q

LOOP ; break operation if greater than 39 characters

 ;

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

 ;

 Q

PAGE ; end of page

 I 'SRHDR S SRHDR=1 D HDR Q

 ;

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

 D HDR

 Q

MORE S SRNAME=$P(^SRO(133.8,SRRECNO,0),"^"),SRNAME=$P(^SRO(137.45,SRNAME,0),"^")

 I SRNAME'=SRSNM Q

 S DFN=SRW D DEM^VADPT S SRSDPT=VADM(1),^TMP("SR",$J,SRSDPT,SRRECNO,SRSUB)=""

 Q

HDR ; print heading

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

 S SRHDR=1 W:$Y @IOF W !,"Surgery Waiting List sorted by Patient ",!,"Surgical Specialty is "_SRSNM,!,"Printed "_SRTIME,!!,"Date Entered",?15,"Patient",?40,"Operative Procedure",! F LINE=1:1:80 W "="

 Q

SRSWL10   ;B'HAM ISC/MAM - WAITING LIST, BRIEF-ALL ; 17 OCT 1989  7:35 AM

 +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       ;

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

               KILL IO("Q")

               SET ZTDESC="SURGERY WAITING LIST"

               SET ZTRTN="BEG^SRSWL10"

               DO ^%ZTLOAD

               GOTO END

BEG       ; entry when queued

 +1        KILL ^TMP("SR",$JOB)

 +2        USE IO

           SET (SRSOUT,SRHDR)=0

           DO NOW^%DTC

           SET Y=%

           DO D^DIQ

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

 +3       ;

 +4        DO HDR

 +5        SET SS=""

           SET ST=""

           SET SR=""

           SET SRW=""

           SET SRNAME=""

           SET SRRECNO=""

           SET SRSUB=""

           SET DFN=""

           SET SRSDPT=""

 +6       ;

 +7        FOR 

               SET SRW=$ORDER(^SRO(133.8,"AP",SRW))

               IF SRW=""

                   QUIT 

               FOR 

                   SET SRRECNO=$ORDER(^SRO(133.8,"AP",SRW,SRRECNO))

                   IF SRRECNO=""

                       QUIT 

                   FOR 

                       SET SRSUB=$ORDER(^SRO(133.8,"AP",SRW,SRRECNO,SRSUB))

                       IF SRSUB=""

                           QUIT 

                       DO MORE

 +8       ;

 +9        FOR 

               SET SS=$ORDER(^TMP("SR",$JOB,SS))

               IF SS=""!(SRSOUT)

                   QUIT 

               FOR 

                   SET SR=$ORDER(^TMP("SR",$JOB,SS,SR))

                   IF SR=""!(SRSOUT)

                       QUIT 

                   FOR 

                       SET ST=$ORDER(^TMP("SR",$JOB,SS,SR,ST))

                       IF ST=""!(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 

PRINT     ; print information

 +1        IF $Y+5>IOSL

               DO PAGE

               IF SRSOUT

                   QUIT 

 +2       ;

 +3        SET SRSDPT=SS

           SET SRSS=SR

           SET SROFN=ST

 +4       ;

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

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

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

           SET Y=$PIECE(SRW,"^",3)

           DO D^DIQ

           SET SRDT=$EXTRACT(Y,1,12)

 +6       ;

 +7        SET Y=$PIECE(SRW,"^",4)

           IF Y=""

               SET SRADT=""

           IF Y

               DO D^DIQ

               SET SRADT=$EXTRACT(Y,1,12)

 +8       ;

 +9        SET (Y,SROPDT)=$PIECE(SRW,"^",5)

           IF Y

               DO D^DIQ

               SET SROPDT=Y

 +10      ;

 +11       SET SRSDPT=$SELECT($LENGTH(SRSDPT)<24:SRSDPT,1:$EXTRACT(SRSDPT,1,23))

 +12      ;

 +13       KILL SROP,MM,MMM

           IF $LENGTH(SROPER)<40

               SET SROP(1)=SROPER

           IF $LENGTH(SROPER)>39

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT 

 +14      ;

 +15       WRITE !,SRDT,?15,SRSDPT,?40,SROP(1),!,"Tentative Admission: "_SRADT

           IF $DATA(SROP(2))

               WRITE ?40,SROP(2)

 +16      ;

 +17       IF SROPDT=""

               SET SROPDT="None Specified"

 +18       WRITE !,"Tentative Date of Operation: "_SROPDT

 +19      ;

 +20       SET SRNAME=$PIECE(^SRO(133.8,SRSS,0),"^")

           SET SRNAME=$PIECE(^SRO(137.45,SRNAME,0),"^")

 +21      ;

 +22       SET SROLD=0

           DO OLD^SRSWLST

           IF SROLD

               WRITE !,"* Procedure performed since entry on list ("_SROLD("DATE")_")"

 +23      ;

 +24       WRITE !

           FOR LINE=1:1:80

               WRITE "-"

 +25       QUIT 

LOOP      ; break operation if greater than 39 characters

 +1       ;

 +2        SET SROP(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

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

               IF MMM=""

                   QUIT 

               IF $LENGTH(SROP(M))+$LENGTH(MM)'<39

                   QUIT 

               SET SROP(M)=SROP(M)_MM_" "

               SET SROPER=MMM

 +3       ;

 +4        QUIT 

PAGE      ; end of page

 +1        IF 'SRHDR

               SET SRHDR=1

               DO HDR

               QUIT 

 +2       ;

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

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

               READ X:DTIME

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

                   SET SRSOUT=1

                   QUIT 

 +4        DO HDR

 +5        QUIT 

MORE       SET SRNAME=$PIECE(^SRO(133.8,SRRECNO,0),"^")

           SET SRNAME=$PIECE(^SRO(137.45,SRNAME,0),"^")

 +1        IF SRNAME'=SRSNM

               QUIT 

 +2        SET DFN=SRW

           DO DEM^VADPT

           SET SRSDPT=VADM(1)

           SET ^TMP("SR",$JOB,SRSDPT,SRRECNO,SRSUB)=""

 +3        QUIT 

HDR       ; print heading

 +1        IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT 

 +2        SET SRHDR=1

           IF $Y

               WRITE @IOF

           WRITE !,"Surgery Waiting List sorted by Patient ",!,"Surgical Specialty is "_SRSNM,!,"Printed "_SRTIME,!!,"Date Entered",?15,"Patient",?40,"Operative Procedure",!

           FOR LINE=1:1:80

               WRITE "="

 +3        QUIT