Routine: SDWLR30

SDWLR30 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM);06/12/2002

 ;;5.3;scheduling;**524**;AUG 13 1993;Build 29

EN ;ENTRY POINT

 N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK

 N SDTEAM,SDHIST,SDACTIVE

 D HD

1 S SDWLINST="",SDWLERR=0,SDWLE=0 K ^TMP("SDWLR30",$J),DIC,DIR,DR,DIE

 D INS G END:SDWLERR

2 D OPEN G 1:SDWLERR

 S ^TMP("SDWLR30",$J,"DATE")=""

3 D DATE G 2:SDWLERR

 D QUE

INS ;Get Institution

 S (DIC("B"),DIR("B"))="ALL",SDWLERR=0

IN1 W ! S DIR("A")="Institution",DIR(0)="F^1:30" D ^DIR

 I Y="All"!(Y="")!(Y="all")!(Y="ALL") S ^TMP("SDWLR30",$J,"INS")=Y Q

 I Y["^" S SDWLERR=1 Q

 S DIC("S")="I $$GET1^DIQ(4,+Y_"","",11,""I"")=""N"",$$TF^XUAF4(+Y)"

 S X=Y,DIC(0)="EMNZQ",DIC=4 D ^DIC G IN1:Y<0 S SDWLINS=Y

 I X="^",'$G(SDWLINST) S SDWLERR=1 Q

 I Y<0,'$G(SDWLINST) S SDWLERR=1

 Q:SDWLINS=""  S SDWLINST=SDWLINST_SDWLINS_";",SDWLINST(SDWLINS)=""

 S ^TMP("SDWLR30",$J,"INS")=SDWLINST,^TMP("SDWLR30",$J,"INS",SDWLINS)=""

 G IN1:Y<0,END:$D(DUOUT)

 S DIR("B")="NO",DIR("A")="Select Another Institution",DIR(0)="Y" D ^DIR

 I Y K DIR("B") G IN1

IN3 K DIR,DIC,SDWLINST,SDWLINS,X,Y

OPEN ;OPEN Wait List Entries

 S %=1,SDWLERR=0 W !!,"Do you want only 'OPEN' Wait List Entries " D YN^DICN

 I '% W *7,"Must Enter 'YES' or 'NO'." G OPEN

 I %=-1 S SDWLERR=1

 S ^TMP("SDWLR30",$J,"OPEN")=$S(%=1:"O",1:"OC")

DATE ;Date range selection

 S %=1 W !!,"Print Report for ALL dates? " D YN^DICN

 I %=1 S ^TMP("SDWLR30",$J,"DATE")="ALL" G E1

 Q:%=0

 I %=-1 S SDWLERR=1 Q

 S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with Date Entered: " D ^%DT

 I Y<1 S SDWLERR=1 Q

 S SDWLBDT=Y

 S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT

 I X["^" S SDWLERR=1 Q

 G E1:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")

 I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE

 S ^TMP("SDWLR30",$J,"DATE")=SDWLBDT_"^"_SDWLEDT Q

E1 Q

QUE ;Queue Report

 N ZTQUEUED,POP S ^TMP("SDWLR30","JOB")=$J

 K %ZIS,IOP,IOC,ZTIO,SDWLSPT S %ZIS="MQ" D ^%ZIS I POP W " NOT QUEUED" G END

 S ZTRTN="EN^SDWLR31",ZTDTH=$H,ZTDESC="WAIT LIST 30/120 REPORT"

 S SDWLTASK="" F  S SDWLTASK=$O(^TMP("SDWLR30",$J,SDWLTASK)) Q:SDWLTASK=""  D

 .S SDWLTK=$G(^TMP("SDWLR30",$J,SDWLTASK))

 .S ZTSAVE(SDWLTASK)=SDWLTK

 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G END

QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT

END K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI

 K DIR,DIC,DR,DIE,SDWLSPT,I

 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 K DUOUT,SDWLBDT,SDWLE,SDWLEDT,SDWLERR,SDWLTK

HD W:$D(IOF) @IOF W !,?80-$L("EWL Under 30/Over 30/120 Day Wait List Report")\2,"EWL Under 30/Over 30/120 Day Wait List Report"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLR30   2744     printed  Apr 23, 2025@19:17:42                                                                                                                                                                                                     Page 2

SDWLR30   ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM);06/12/2002

 +1       ;;5.3;scheduling;**524**;AUG 13 1993;Build 29

 +2       ;

 +3       ;

 +4       ;

 +5       ;

 +6       ;

 +7       ;

 +8       ;

 +9       ;

 +10      ;

 +11       QUIT

EN        ;ENTRY POINT

 +1        NEW ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK

 +2        NEW SDTEAM,SDHIST,SDACTIVE

 +3        DO HD

1          SET SDWLINST=""

           SET SDWLERR=0

           SET SDWLE=0

           KILL ^TMP("SDWLR30",$JOB),DIC,DIR,DR,DIE

 +1        DO INS

           if SDWLERR

               GOTO END

2          DO OPEN

           if SDWLERR

               GOTO 1

 +1        SET ^TMP("SDWLR30",$JOB,"DATE")=""

3          DO DATE

           if SDWLERR

               GOTO 2

 +1        DO QUE

 +2        QUIT

INS       ;Get Institution

 +1        SET (DIC("B"),DIR("B"))="ALL"

           SET SDWLERR=0

IN1        WRITE !

           SET DIR("A")="Institution"

           SET DIR(0)="F^1:30"

           DO ^DIR

 +1        IF Y="All"!(Y="")!(Y="all")!(Y="ALL")

               SET ^TMP("SDWLR30",$JOB,"INS")=Y

               QUIT

 +2        IF Y["^"

               SET SDWLERR=1

               QUIT

 +3        SET DIC("S")="I $$GET1^DIQ(4,+Y_"","",11,""I"")=""N"",$$TF^XUAF4(+Y)"

 +4        SET X=Y

           SET DIC(0)="EMNZQ"

           SET DIC=4

           DO ^DIC

           if Y<0

               GOTO IN1

           SET SDWLINS=Y

 +5        IF X="^"

               IF '$GET(SDWLINST)

                   SET SDWLERR=1

                   QUIT

 +6        IF Y<0

               IF '$GET(SDWLINST)

                   SET SDWLERR=1

 +7        if SDWLINS=""

               QUIT

           SET SDWLINST=SDWLINST_SDWLINS_";"

           SET SDWLINST(SDWLINS)=""

 +8        SET ^TMP("SDWLR30",$JOB,"INS")=SDWLINST

           SET ^TMP("SDWLR30",$JOB,"INS",SDWLINS)=""

 +9        if Y<0

               GOTO IN1

           if $DATA(DUOUT)

               GOTO END

 +10       SET DIR("B")="NO"

           SET DIR("A")="Select Another Institution"

           SET DIR(0)="Y"

           DO ^DIR

 +11       IF Y

               KILL DIR("B")

               GOTO IN1

IN3        KILL DIR,DIC,SDWLINST,SDWLINS,X,Y

 +1        QUIT

OPEN      ;OPEN Wait List Entries

 +1        SET %=1

           SET SDWLERR=0

           WRITE !!,"Do you want only 'OPEN' Wait List Entries "

           DO YN^DICN

 +2        IF '%

               WRITE *7,"Must Enter 'YES' or 'NO'."

               GOTO OPEN

 +3        IF %=-1

               SET SDWLERR=1

 +4        SET ^TMP("SDWLR30",$JOB,"OPEN")=$SELECT(%=1:"O",1:"OC")

 +5        QUIT

DATE      ;Date range selection

 +1        SET %=1

           WRITE !!,"Print Report for ALL dates? "

           DO YN^DICN

 +2        IF %=1

               SET ^TMP("SDWLR30",$JOB,"DATE")="ALL"

               GOTO E1

 +3        if %=0

               QUIT

 +4        IF %=-1

               SET SDWLERR=1

               QUIT

 +5        SET SDWLERR=0

           WRITE !

           SET %DT="AE"

           SET %DT("A")="Start with Date Entered: "

           DO ^%DT

 +6        IF Y<1

               SET SDWLERR=1

               QUIT

 +7        SET SDWLBDT=Y

 +8        SET %DT(0)=SDWLBDT

           SET %DT("A")="End with Date Entered: "

           DO ^%DT

 +9        IF X["^"

               SET SDWLERR=1

               QUIT

 +10       if Y<1

               GOTO E1

           SET SDWLEDT=Y

           KILL %DT(0),%DT("A")

 +11       IF SDWLEDT<SDWLBDT

               WRITE !,"Beginning Date must be greater than Ending Date."

               GOTO DATE

 +12       SET ^TMP("SDWLR30",$JOB,"DATE")=SDWLBDT_"^"_SDWLEDT

           QUIT

E1         QUIT

QUE       ;Queue Report

 +1        NEW ZTQUEUED,POP

           SET ^TMP("SDWLR30","JOB")=$JOB

 +2        KILL %ZIS,IOP,IOC,ZTIO,SDWLSPT

           SET %ZIS="MQ"

           DO ^%ZIS

           IF POP

               WRITE " NOT QUEUED"

               GOTO END

 +3        SET ZTRTN="EN^SDWLR31"

           SET ZTDTH=$HOROLOG

           SET ZTDESC="WAIT LIST 30/120 REPORT"

 +4        SET SDWLTASK=""

FOR

               SET SDWLTASK=$ORDER(^TMP("SDWLR30",$JOB,SDWLTASK))

               if SDWLTASK=""

                   QUIT

               Begin DoDot:1

 +5                SET SDWLTK=$GET(^TMP("SDWLR30",$JOB,SDWLTASK))

 +6                SET ZTSAVE(SDWLTASK)=SDWLTK

               End DoDot:1

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

               KILL IO("Q")

               DO ^%ZTLOAD

               WRITE !,"REQUEST QUEUED"

               GOTO END

QUE1       if $EXTRACT(IOST,1,2)="C-"

               SET SDWLSPT=1

           IF $DATA(ZTRTN)

               USE IO

               DO @ZTRTN

               KILL SDWLSPT

 +1       ;

END        KILL SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI

 +1        KILL DIR,DIC,DR,DIE,SDWLSPT,I

 +2        DO ^%ZISC

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        KILL DUOUT,SDWLBDT,SDWLE,SDWLEDT,SDWLERR,SDWLTK

 +4        QUIT

HD         if $DATA(IOF)

               WRITE @IOF

           WRITE !,?80-$LENGTH("EWL Under 30/Over 30/120 Day Wait List Report")\2,"EWL Under 30/Over 30/120 Day Wait List Report"

SDWLR30.m