Routine: SRSWL12

SRSWL12 ;BIR/MAM - WAITING LIST, BRIEF-ALL ; [ 12/06/99  9:45 AM ]

 ;;3.0; Surgery ;**92**;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^SRSWL12" 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)

 ; The AP cross reference is used to get the Patient Number, the record

 ; number and sub-record number associated with that Patient.

 ; SRPNM is set to Patient Number; SRSS = the record #; SROFN =

 ; sub-record; SRSNM is set to the Surgical Specialty. The TMP

 ; global is set to contain the Surgical Specialty, Tentative Date

 ; of Operation, and corresponding record and subrecord numbers.

 S SRPNM="" F  S SRPNM=$O(^SRO(133.8,"AP",SRPNM)) Q:SRPNM=""  S SRSS="" F  S SRSS=$O(^SRO(133.8,"AP",SRPNM,SRSS)) Q:SRSS=""  S SROFN="" F  S SROFN=$O(^SRO(133.8,"AP",SRPNM,SRSS,SROFN)) Q:SROFN=""  D MORE

 ; Below, extract information from TMP in order of Surgical

 ; Specialty and within Surgical Specialty by Tentative Date of

 ; Operation.

 S SRSNM="" F  S SRSNM=$O(^TMP("SR",$J,SRSNM)) Q:SRSNM=""!SRSOUT  D

 .D PAGE Q:SRSOUT  S SROPDT="" F  S SROPDT=$O(^TMP("SR",$J,SRSNM,SROPDT)) Q:SROPDT=""!SRSOUT  S SRSS="" F  S SRSS=$O(^TMP("SR",$J,SRSNM,SROPDT,SRSS)) Q:SRSS=""!SRSOUT  D ANOTHER

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, or '^' to quit:  " R X:DTIME W @IOF

 D ^%ZISC,^SRSKILL K SRTN

MORE S SRSNM=$P(^SRO(133.8,SRSS,0),"^"),SRSNM=$P(^SRO(137.45,SRSNM,0),"^"),SRTEMP=^SRO(133.8,SRSS,1,SROFN,0),SROPDT=$P($G(SRTEMP),"^",5),SROPDT=$S(SROPDT'="":SROPDT,1:"None Specified"),^TMP("SR",$J,SRSNM,SROPDT,SRSS,SROFN)=""

ANOTHER S SROFN="" F  S SROFN=$O(^TMP("SR",$J,SRSNM,SROPDT,SRSS,SROFN)) Q:'SROFN!SRSOUT  D PRINT

PRINT ; print information

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

 S SRW=^SRO(133.8,SRSS,1,SROFN,0),DFN=$P(SRW,"^") D DEM^VADPT S SRSDPT=VADM(1),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 TEMPDT=SROPDT

 I TEMPDT?7N S Y=TEMPDT D D^DIQ S TEMPDT=$E(Y,1,12)

 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)

 W !,"Tentative Date of Operation: "_TEMPDT

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

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

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

HDR ; print heading

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

 S SRHDR=1 W:$Y @IOF W !,"Surgery Waiting List for ",SRSNM,!,"Printed "_SRTIME,!!,"Date Entered",?15,"Patient",?40,"Operative Procedure",! F LINE=1:1:80 W "="

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSWL12   3365     printed  Apr 23, 2025@19:02:36                                                                                                                                                                                                     Page 2

SRSWL12   ;BIR/MAM - WAITING LIST, BRIEF-ALL ; [ 12/06/99  9:45 AM ]

 +1       ;;3.0; Surgery ;**92**;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^SRSWL12"

               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       ; The AP cross reference is used to get the Patient Number, the record

 +5       ; number and sub-record number associated with that Patient.

 +6       ; SRPNM is set to Patient Number; SRSS = the record #; SROFN =

 +7       ; sub-record; SRSNM is set to the Surgical Specialty. The TMP

 +8       ; global is set to contain the Surgical Specialty, Tentative Date

 +9       ; of Operation, and corresponding record and subrecord numbers.

 +10      ;

 +11       SET SRPNM=""

FOR

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

               if SRPNM=""

                   QUIT

               SET SRSS=""

FOR

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

                   if SRSS=""

                       QUIT

                   SET SROFN=""

FOR

                       SET SROFN=$ORDER(^SRO(133.8,"AP",SRPNM,SRSS,SROFN))

                       if SROFN=""

                           QUIT

                       DO MORE

 +12      ;

 +13      ; Below, extract information from TMP in order of Surgical

 +14      ; Specialty and within Surgical Specialty by Tentative Date of

 +15      ; Operation.

 +16      ;

 +17       SET SRSNM=""

FOR

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

               if SRSNM=""!SRSOUT

                   QUIT

               Begin DoDot:1

 +18               DO PAGE

                   if SRSOUT

                       QUIT

                   SET SROPDT=""

FOR

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

                       if SROPDT=""!SRSOUT

                           QUIT

                       SET SRSS=""

FOR

                           SET SRSS=$ORDER(^TMP("SR",$JOB,SRSNM,SROPDT,SRSS))

                           if SRSS=""!SRSOUT

                               QUIT

                           DO ANOTHER

               End DoDot:1

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, or '^' to quit:  "

               READ X:DTIME

               WRITE @IOF

 +3        DO ^%ZISC

           DO ^SRSKILL

           KILL SRTN

 +4        QUIT

MORE       SET SRSNM=$PIECE(^SRO(133.8,SRSS,0),"^")

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

           SET SRTEMP=^SRO(133.8,SRSS,1,SROFN,0)

           SET SROPDT=$PIECE($GET(SRTEMP),"^",5)

           SET SROPDT=$SELECT(SROPDT'="":SROPDT,1:"None Specified")

           SET ^TMP("SR",$JOB,SRSNM,SROPDT,SRSS,SROFN)=""

 +1        QUIT

ANOTHER    SET SROFN=""

FOR

               SET SROFN=$ORDER(^TMP("SR",$JOB,SRSNM,SROPDT,SRSS,SROFN))

               if 'SROFN!SRSOUT

                   QUIT

               DO PRINT

 +1        QUIT

PRINT     ; print information

 +1        IF $Y+5>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)

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

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

           DO D^DIQ

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

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

           if Y=""

               SET SRADT=""

           IF Y

               DO D^DIQ

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

 +4        SET TEMPDT=SROPDT

 +5        IF TEMPDT?7N

               SET Y=TEMPDT

               DO D^DIQ

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

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

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

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

           IF $DATA(SROP(2))

               WRITE ?40,SROP(2)

 +9        WRITE !,"Tentative Date of Operation: "_TEMPDT

 +10       SET SROLD=0

           DO OLD^SRSWLST

           IF SROLD

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

 +11       WRITE !

           FOR LINE=1:1:80

               WRITE "-"

 +12       QUIT

PAGE      ; end of page

 +1        IF 'SRHDR

               SET SRHDR=1

               DO HDR

               QUIT

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

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

               READ X:DTIME

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

                   SET SRSOUT=1

                   QUIT

 +3        DO HDR

 +4        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 for ",SRSNM,!,"Printed "_SRTIME,!!,"Date Entered",?15,"Patient",?40,"Operative Procedure",!

           FOR LINE=1:1:80

               WRITE "="

 +3        QUIT

LOOP      ; break operation if greater than 39 characters

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

 +2        QUIT

SRSWL12.m