- SDWLQSR ;BPOI/TEH - WAIT LIST STAT REPORT;06/12/02
- ;;5.3;scheduling;**263,425,448,524**;08/13/93;Build 29
- ;
- ;
- ;
- ;
- ;
- EN N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,POP
- K ^TMP("SDWLQSR",$J)
- D HD
- 1 D INS G END:$D(DUOUT)
- 2 D DATE G END:$D(DUOUT)
- 3 D EXCL 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("SDWLQSR",$J,"INS")="ALL" G IN3
- S SDWLINST=SDWLINST_Y_";",SDWLPROM="Another Institution: ",SDWLERR=1 G IN
- IN2 S ^TMP("SDWLQSR",$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("SDWLQSR",$J,"DATE")=SDWLBDT_"^"_SDWLEDT K DIR,DIC,DIE,%DT Q
- Q
- EXCL ;EXCLUDE # REMAINING =0 - PATCH SD*5.3*524
- S SDWLEXCL=0,^TMP("SDWLQSR",$J,"EXCL")=0
- S DIR("A",1)="Do you wish to exclude any Teams, Specialities or Specific"
- S DIR("A")="Clinics where ALL values are zero"
- S DIR("B")="YES",DIR(0)="Y^A0" D ^DIR
- I X["^" S DUOUT=1 Q
- I Y<0 S DUOUT=1 Q
- EXCL1 I Y S SDWLEXCL=1,^TMP("SDWLQSR",$J,"EXCL")=SDWLEXCL
- K DIR,X,Y,SDWLEXCL
- Q
- QUE ;Queue Report
- N ZTQUEUED,POP
- K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP QUE1
- S ZTRTN="EN^SDWLRSR",ZTDTH=$H,ZTDESC="WAIT LIST STAT REPORT"
- S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLQSR",$J,SDWLTASK)) Q:SDWLTASK="" D
- .S SDWLTK=$G(^TMP("SDWLQSR",$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-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT
- ;
- ;
- QUE2 K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
- K DIR,DIC,DR,DIE
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- END D EN^SDWLKIL
- K DUOUT,SDWLBDT,SDWLEDT,SDWLERR,SDWLIST,SDWLPROM,SDWLTK
- Q
- HD ;
- W:$D(IOF) @IOF W !,?80-$L("Wait List Stat Report")\2,"Wait List Stat Report",!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLQSR 2503 printed Mar 13, 2025@22:08:07 Page 2
- SDWLQSR ;BPOI/TEH - WAIT LIST STAT REPORT;06/12/02
- +1 ;;5.3;scheduling;**263,425,448,524**;08/13/93;Build 29
- +2 ;
- +3 ;
- +4 ;
- +5 ;
- +6 ;
- EN NEW ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,POP
- +1 KILL ^TMP("SDWLQSR",$JOB)
- +2 DO HD
- 1 DO INS
- if $DATA(DUOUT)
- GOTO END
- 2 DO DATE
- if $DATA(DUOUT)
- GOTO END
- 3 DO EXCL
- 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("SDWLQSR",$JOB,"INS")="ALL"
- GOTO IN3
- +4 SET SDWLINST=SDWLINST_Y_";"
- SET SDWLPROM="Another Institution: "
- SET SDWLERR=1
- GOTO IN
- IN2 SET ^TMP("SDWLQSR",$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("SDWLQSR",$JOB,"DATE")=SDWLBDT_"^"_SDWLEDT
- KILL DIR,DIC,DIE,%DT
- QUIT
- +11 QUIT
- EXCL ;EXCLUDE # REMAINING =0 - PATCH SD*5.3*524
- +1 SET SDWLEXCL=0
- SET ^TMP("SDWLQSR",$JOB,"EXCL")=0
- +2 SET DIR("A",1)="Do you wish to exclude any Teams, Specialities or Specific"
- +3 SET DIR("A")="Clinics where ALL values are zero"
- +4 SET DIR("B")="YES"
- SET DIR(0)="Y^A0"
- DO ^DIR
- +5 IF X["^"
- SET DUOUT=1
- QUIT
- +6 IF Y<0
- SET DUOUT=1
- QUIT
- EXCL1 IF Y
- SET SDWLEXCL=1
- SET ^TMP("SDWLQSR",$JOB,"EXCL")=SDWLEXCL
- +1 KILL DIR,X,Y,SDWLEXCL
- +2 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^SDWLRSR"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="WAIT LIST STAT REPORT"
- +4 SET SDWLTASK=""
- FOR
- SET SDWLTASK=$ORDER(^TMP("SDWLQSR",$JOB,SDWLTASK))
- if SDWLTASK=""
- QUIT
- Begin DoDot:1
- +5 SET SDWLTK=$GET(^TMP("SDWLQSR",$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 SDWLSPT=1
- IF $DATA(ZTRTN)
- USE IO
- DO @ZTRTN
- KILL SDWLSPT
- +1 ;
- +2 ;
- QUE2 KILL SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
- +1 KILL DIR,DIC,DR,DIE
- +2 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- END DO EN^SDWLKIL
- +1 KILL DUOUT,SDWLBDT,SDWLEDT,SDWLERR,SDWLIST,SDWLPROM,SDWLTK
- +2 QUIT
- HD ;
- +1 if $DATA(IOF)
- WRITE @IOF
- WRITE !,?80-$LENGTH("Wait List Stat Report")\2,"Wait List Stat Report",!
- +2 QUIT
