source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLR30.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1SDWLR30 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM);06/12/2002
2 ;;5.3;scheduling;**524**;AUG 13 1993;Build 29
3 ;
4 ;
5 ;
6 ;
7 ;
8 ;
9 ;
10 ;
11 ;
12 Q
13EN ;ENTRY POINT
14 N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
15 N SDTEAM,SDHIST,SDACTIVE
16 D HD
171 S SDWLINST="",SDWLERR=0,SDWLE=0 K ^TMP("SDWLR30",$J),DIC,DIR,DR,DIE
18 D INS G END:SDWLERR
192 D OPEN G 1:SDWLERR
20 S ^TMP("SDWLR30",$J,"DATE")=""
213 D DATE G 2:SDWLERR
22 D QUE
23 Q
24INS ;Get Institution
25 S (DIC("B"),DIR("B"))="ALL",SDWLERR=0
26IN1 W ! S DIR("A")="Institution",DIR(0)="F^1:30" D ^DIR
27 I Y="All"!(Y="")!(Y="all")!(Y="ALL") S ^TMP("SDWLR30",$J,"INS")=Y Q
28 I Y["^" S SDWLERR=1 Q
29 S DIC("S")="I $$GET1^DIQ(4,+Y_"","",11,""I"")=""N"",$$TF^XUAF4(+Y)"
30 S X=Y,DIC(0)="EMNZQ",DIC=4 D ^DIC G IN1:Y<0 S SDWLINS=Y
31 I X="^",'$G(SDWLINST) S SDWLERR=1 Q
32 I Y<0,'$G(SDWLINST) S SDWLERR=1
33 Q:SDWLINS="" S SDWLINST=SDWLINST_SDWLINS_";",SDWLINST(SDWLINS)=""
34 S ^TMP("SDWLR30",$J,"INS")=SDWLINST,^TMP("SDWLR30",$J,"INS",SDWLINS)=""
35 G IN1:Y<0,END:$D(DUOUT)
36 S DIR("B")="NO",DIR("A")="Select Another Institution",DIR(0)="Y" D ^DIR
37 I Y K DIR("B") G IN1
38IN3 K DIR,DIC,SDWLINST,SDWLINS,X,Y
39 Q
40OPEN ;OPEN Wait List Entries
41 S %=1,SDWLERR=0 W !!,"Do you want only 'OPEN' Wait List Entries " D YN^DICN
42 I '% W *7,"Must Enter 'YES' or 'NO'." G OPEN
43 I %=-1 S SDWLERR=1
44 S ^TMP("SDWLR30",$J,"OPEN")=$S(%=1:"O",1:"OC")
45 Q
46DATE ;Date range selection
47 S %=1 W !!,"Print Report for ALL dates? " D YN^DICN
48 I %=1 S ^TMP("SDWLR30",$J,"DATE")="ALL" G E1
49 Q:%=0
50 I %=-1 S SDWLERR=1 Q
51 S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with Date Entered: " D ^%DT
52 I Y<1 S SDWLERR=1 Q
53 S SDWLBDT=Y
54 S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT
55 I X["^" S SDWLERR=1 Q
56 G E1:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
57 I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
58 S ^TMP("SDWLR30",$J,"DATE")=SDWLBDT_"^"_SDWLEDT Q
59E1 Q
60QUE ;Queue Report
61 N ZTQUEUED,POP S ^TMP("SDWLR30","JOB")=$J
62 K %ZIS,IOP,IOC,ZTIO,SDWLSPT S %ZIS="MQ" D ^%ZIS I POP W " NOT QUEUED" G END
63 S ZTRTN="EN^SDWLR31",ZTDTH=$H,ZTDESC="WAIT LIST 30/120 REPORT"
64 S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLR30",$J,SDWLTASK)) Q:SDWLTASK="" D
65 .S SDWLTK=$G(^TMP("SDWLR30",$J,SDWLTASK))
66 .S ZTSAVE(SDWLTASK)=SDWLTK
67 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G END
68QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT
69 ;
70END K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
71 K DIR,DIC,DR,DIE,SDWLSPT,I
72 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
73 K DUOUT,SDWLBDT,SDWLE,SDWLEDT,SDWLERR,SDWLTK
74 Q
75HD 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"
Note: See TracBrowser for help on using the repository browser.