SDWLQOI ;;IOFO BAY PINES/TEH/WAIT LIST STAT REPORT - ENROLLEE SORT
;;5.3;scheduling;**263,425,448**;AUG 13 1993
;
;
;
;
;
EN D HD
1 D INS G END:$D(DUOUT)
2 D DATE G END:$D(DUOUT)
D QUE G END:$D(DUOUT)
Q
INS ;Get Institution
S SDWLERR=0,SDWLPROM="Select Institution ALL // ",SDWLINST=""
IN W ! S DIC(0)="QEMA",DIC("A")=SDWLPROM,DIC=4,DIC("S")="I $D(^SDWL(409.32,""C"",+Y))!$D(^SDWL(409.31,""E"",+Y))!$D(^SCTM(404.51,""AINST"",+Y))" D ^DIC I Y<0,'SDWLERR Q:$D(DUOUT) S Y="ALL"
G IN2:Y<0 Q:$D(DUOUT)
I Y<0 S SDWLINST=$S(Y="ALL":"ALL",Y="":"ALL",Y="all":"ALL",Y="All":"ALL",Y["A":"ALL",Y["a":"ALL")
I Y="All"!(Y="")!(Y="all")!(Y="ALL") S SDWLINST="ALL",^TMP("SDWLROI",$J,"INS")="ALL" G IN3
S SDWLINST=SDWLINST_Y_";",SDWLPROM="Another Institution: ",SDWLERR=1 G IN
IN2 S ^TMP("SDWLROI",$J,"INS")=SDWLINST
IN3 Q
DATE ;Date range selection
K X,Y,%DT
S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start Date: " D ^%DT
I X["^" S DUOUT=1 Q
I Y<0 S DUOUT=1 Q
S SDWLBDT=Y
Q:$D(DUOUT)
S %DT("A")="End Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
G DATE:$D(DUOUT)
I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
S ^TMP("SDWLROI",$J,"DATE")=SDWLBDT_"^"_SDWLEDT K DIR,DIC,DIE,%DT Q
Q
QUE ;Queue Report
N ZTQUEUED,POP
K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP QUE1
S ZTRTN="EN^SDWLROI",ZTDTH=$H,ZTDESC="WAIT LIST ENROLL STAT REPORT"
S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLROI",$J,SDWLTASK)) Q:SDWLTASK="" D
.S SDWLTK=$G(^TMP("SDWLROI",$J,SDWLTASK))
.S ZTSAVE(SDWLTASK)=SDWLTK
I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G QUE2
QUE1 S:$E(IOST,1,2)="C-" SDWLIOSR=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLIOSR
;
;
QUE2 K SDWLTASK,SDWLY,SDWLED,SDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
K DIR,DIC,DR,DIE
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
END D EN^SDWLKIL K SDWLIOSR Q
HD ;
W:$D(IOF) @IOF W !,?80-$L("Wait List Enrollment Status Report")\2,"Wait List Enrollment Status Report",!
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLQOI 1994 printed Nov 22, 2024@18:12:52 Page 2
SDWLQOI ;;IOFO BAY PINES/TEH/WAIT LIST STAT REPORT - ENROLLEE SORT
+1 ;;5.3;scheduling;**263,425,448**;AUG 13 1993
+2 ;
+3 ;
+4 ;
+5 ;
+6 ;
EN DO HD
1 DO INS
if $DATA(DUOUT)
GOTO END
2 DO DATE
if $DATA(DUOUT)
GOTO END
+1 DO QUE
if $DATA(DUOUT)
GOTO END
+2 QUIT
INS ;Get Institution
+1 SET SDWLERR=0
SET SDWLPROM="Select Institution ALL // "
SET SDWLINST=""
IN WRITE !
SET DIC(0)="QEMA"
SET DIC("A")=SDWLPROM
SET DIC=4
SET DIC("S")="I $D(^SDWL(409.32,""C"",+Y))!$D(^SDWL(409.31,""E"",+Y))!$D(^SCTM(404.51,""AINST"",+Y))"
DO ^DIC
IF Y<0
IF 'SDWLERR
if $DATA(DUOUT)
QUIT
SET Y="ALL"
+1 if Y<0
GOTO IN2
if $DATA(DUOUT)
QUIT
+2 IF Y<0
SET SDWLINST=$SELECT(Y="ALL":"ALL",Y="":"ALL",Y="all":"ALL",Y="All":"ALL",Y["A":"ALL",Y["a":"ALL")
+3 IF Y="All"!(Y="")!(Y="all")!(Y="ALL")
SET SDWLINST="ALL"
SET ^TMP("SDWLROI",$JOB,"INS")="ALL"
GOTO IN3
+4 SET SDWLINST=SDWLINST_Y_";"
SET SDWLPROM="Another Institution: "
SET SDWLERR=1
GOTO IN
IN2 SET ^TMP("SDWLROI",$JOB,"INS")=SDWLINST
IN3 QUIT
DATE ;Date range selection
+1 KILL X,Y,%DT
+2 SET SDWLERR=0
WRITE !
SET %DT="AE"
SET %DT("A")="Start Date: "
DO ^%DT
+3 IF X["^"
SET DUOUT=1
QUIT
+4 IF Y<0
SET DUOUT=1
QUIT
+5 SET SDWLBDT=Y
+6 if $DATA(DUOUT)
QUIT
+7 SET %DT("A")="End Date: "
DO ^%DT
if Y<1
GOTO DATE
SET SDWLEDT=Y
KILL %DT(0),%DT("A")
+8 if $DATA(DUOUT)
GOTO DATE
+9 IF SDWLEDT<SDWLBDT
WRITE !,"Beginning Date must be greater than Ending Date."
GOTO DATE
+10 SET ^TMP("SDWLROI",$JOB,"DATE")=SDWLBDT_"^"_SDWLEDT
KILL DIR,DIC,DIE,%DT
QUIT
+11 QUIT
QUE ;Queue Report
+1 NEW ZTQUEUED,POP
+2 KILL %ZIS,IOP,IOC,ZTIO
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO QUE1
+3 SET ZTRTN="EN^SDWLROI"
SET ZTDTH=$HOROLOG
SET ZTDESC="WAIT LIST ENROLL STAT REPORT"
+4 SET SDWLTASK=""
FOR
SET SDWLTASK=$ORDER(^TMP("SDWLROI",$JOB,SDWLTASK))
if SDWLTASK=""
QUIT
Begin DoDot:1
+5 SET SDWLTK=$GET(^TMP("SDWLROI",$JOB,SDWLTASK))
+6 SET ZTSAVE(SDWLTASK)=SDWLTK
End DoDot:1
+7 IF $DATA(IO("Q"))
KILL IO("Q")
DO ^%ZTLOAD
WRITE !,"REQUEST QUEUED"
GOTO QUE2
QUE1 if $EXTRACT(IOST,1,2)="C-"
SET SDWLIOSR=1
IF $DATA(ZTRTN)
USE IO
DO @ZTRTN
KILL SDWLIOSR
+1 ;
+2 ;
QUE2 KILL SDWLTASK,SDWLY,SDWLED,SDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
+1 KILL DIR,DIC,DR,DIE
+2 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
END DO EN^SDWLKIL
KILL SDWLIOSR
QUIT
HD ;
+1 if $DATA(IOF)
WRITE @IOF
WRITE !,?80-$LENGTH("Wait List Enrollment Status Report")\2,"Wait List Enrollment Status Report",!
