source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLQSR.m@ 836

Last change on this file since 836 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 1.9 KB
RevLine 
[623]1SDWLQSR ;;IOFO BAY PINES/TEH/WAIT LIST STAT REPORT
2 ;;5.3;scheduling;**263,425,448**;AUG 13 1993
3 ;
4 ;
5 ;
6 ;
7 ;
8EN N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,POP
9 D HD
101 D INS G END:$D(DUOUT)
112 D DATE G END:$D(DUOUT)
12 D QUE G END:$D(DUOUT)
13 Q
14INS ;Get Institution
15 S SDWLERR=0,SDWLPROM="Select Institution ALL // ",SDWLINST=""
16IN 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"
17 G IN2:Y<0 Q:$D(DUOUT)
18 I Y<0 S SDWLINST=$S(Y="ALL":"ALL",Y="":"ALL",Y="all":"ALL",Y="All":"ALL",Y["A":"ALL",Y["a":"ALL")
19 I Y="All"!(Y="")!(Y="all")!(Y="ALL") S SDWLINST="ALL",^TMP("SDWLQSR",$J,"INS")="ALL" G IN3
20 S SDWLINST=SDWLINST_Y_";",SDWLPROM="Another Institution: ",SDWLERR=1 G IN
21IN2 S ^TMP("SDWLQSR",$J,"INS")=SDWLINST
22IN3 Q
23DATE ;Date range selection
24 K X,Y,%DT
25 S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start Date: " D ^%DT
26 I X["^" S DUOUT=1 Q
27 I Y<0 S DUOUT=1 Q
28 S SDWLBDT=Y
29 Q:$D(DUOUT)
30 S %DT("A")="End Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
31 G DATE:$D(DUOUT)
32 I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
33 S ^TMP("SDWLQSR",$J,"DATE")=SDWLBDT_"^"_SDWLEDT K DIR,DIC,DIE,%DT Q
34 Q
35QUE ;Queue Report
36 N ZTQUEUED,POP
37 K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP QUE1
38 S ZTRTN="EN^SDWLRSR",ZTDTH=$H,ZTDESC="WAIT LIST STAT REPORT"
39 S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLQSR",$J,SDWLTASK)) Q:SDWLTASK="" D
40 .S SDWLTK=$G(^TMP("SDWLQSR",$J,SDWLTASK))
41 .S ZTSAVE(SDWLTASK)=SDWLTK
42 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G QUE2
43QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT
44 ;
45 ;
46QUE2 K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
47 K DIR,DIC,DR,DIE
48 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
49 Q
50END D EN^SDWLKIL Q
51HD ;
52 W:$D(IOF) @IOF W !,?80-$L("Wait List Stat Report")\2,"Wait List Stat Report",!
53 Q
Note: See TracBrowser for help on using the repository browser.