SDWLR30 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM);06/12/2002
;;5.3;scheduling;**524**;AUG 13 1993;Build 29
;
;
;
;
;
;
;
;
;
Q
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
Q
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
Q
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")
Q
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
Q
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 09, 2024@21:43: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"
