source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLRAD.m@ 1306

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1SDWLRAD ;;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT;06/12/2002 ; 20 Aug 2002 2:10 PM
2 ;;5.3;scheduling;**263**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;
12 ;
13 ;
14EN ;Header
15 D HD
16 S SDWLINST="",SDWLE=0 K ^TMP("SDWLRAD",$J),DIC,DIR,DR,DIE
17 D INS
18 D DATE G INS:E
19 D CAT G DATE:E
20 D PRI G CAT:E
21 D OPEN G PRI:E
22 D FORM G OPEN:E
23 D DIS
24 I E D QUE
25 Q
26INS ;Get Institution
27 W !! S DIC(0)="QEMA",DIC("A")="Select Institution ALL // ",DIC=4,DIC("S")="I $D(^SDWL(409.32,""C"",+Y))" D ^DIC I Y<0,'SDWLE S Y="ALL"
28 G INS:Y<0,END:$D(DUOUT)
29 I Y="All"!(Y="")!(Y="all")!(Y="ALL") D
30 .S SDWLINST="ALL",SDWLE=1 S ^TMP("SDWLRAD",$J,"INS","ALL")=""
31 I 'SDWLE S SDWLERR=1,^TMP("SDWLRAD",$J,"INS",Y)="" G INS
32 Q
33DATE ;Date range selection
34 S SDWLERR=0 W ! S %DT="AE",%DT("A")="Beginning Date: " D ^%DT G E1:Y<1 S SDWLBDT=Y
35 S %DT(0)=SDWLBDT,%DT("A")="Ending Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
36 I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
37 S ^TMP("SDWLRAD",$J,"DATE",SDWLBDT_"^"_SDWLEDT)="" Q
38E1 S %=1 W !,"Print Report for ALL dates? " D YN^DICN S ^TMP("SDWLRAD",$J,"DATE","ALL")=""
39 I %=2 S SDWLERR=1 Q
40 I %=-1 G END
41 Q
42CAT ;Report category selection
43 W !!," *** Report Category Selection ***" S SDWLERR=0
44 S SDWLCAT=0,DIR(0)="S0^1:Clinic;2:Select Service/Specialty",DIR("L",1)="C. Clinic",DIR("L")="S. Service/Specialty"
45 D ^DIR
46 I X="^" S SDWLERR=1 Q
47 I X="" S SDWLERR=1 Q
48 I X'?1"C".E,X'?1"S".E W " Invalid Selection." G CAT
49 W !!,"Select Category for Report Output",!
50 S SDWLX=$S(X="C":"Clinic: ALL/ ",X="S":"Service/Specialty: ALL/ ")
51 S SDWLF=$S(X="C":409.32,X="S":409.31)
52CT1 W !! S DIC(0)="QEMA",DIC("A")=SDWLX,DIC=SDWLF D ^DIC I 'SDWLCAT,Y<1 S ^TMP("SDWLRAD",$J,"CAT","ALL")="" G CT2
53 I SDWLCAT,Y<0 S SDWLERR=1 Q
54 I 'SDWLCAT,Y<0 S SDWLERR=1 Q
55 S SDWLCAT=1
56 S ^TMP("SDWLRAD",$J,"CAT",Y)="" G CT1
57CT2 Q
58PRI ;Priority
59 K DIR,DIC S SDWLERR=0
60 S DIR(0)="S0^1:F:Future;I:Immediate",DIR("L",2)=" F. Future",DIR("L")=" I. Immediate",DIR("L",1)="Select One of the Following: "
61 D ^DIR
62 I X="" S SDWLERR=1 Q
63 I X="^" S SDWLERR=1 Q
64 S ^TMP("SDWLRAD",$J,"PRI",X)=""
65 Q
66OPEN ;OPEN Wait List Entries
67 S %=1 W !!,"Do you want to 'OPEN' Wait List Entries " D YN^DICN
68 I %=-1 S SDWLERR=1
69 S ^TMP("SDWLRAD",$J,"OPEN",%)=""
70 Q
71FORM ;Report Format
72 S SDWLERR=0,DIR(0)="SO^1:D:Detailed;S:Summary",DIR("L",2)="D. Detailed",DIR("L")="S. Summary",DIR("L",1)="Select One of the Following: "
73 D ^DIR
74 I X="",X="^" S SDWLERR=1
75 S ^TMP("SDWLRAD",$J,"FORM",X)=""
76 Q
77DIS ;Display Parameters
78 S SDWLERR=0 W !!,?80-$L("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters",!
79 F SDWLI="CAT","DATE","INS","FORM","OPEN","PRI" D
80 .S X="SDWL"_SDWLI,@X=$O(^TMP("SDWLRAD",$J,SDWLI,""))
81 I SDWLINS'="ALL" D
82 .I 'E W !,"Institution: ALL INSTITUTIONS"
83 W !,"Date Desired Range: " S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBD=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLED=Y W " ",SDWLBD," to ",SDWLED
84 W !,"Report Category: ",$S(SDWLCAT="C":" Clinic",1:" Service/Specialty")
85 W !,"Priority: ",$S(SDWLPRI="I":" Immediate",1:" Future")
86 W !,"Output Format: ",$S(SDWLFORM="D":" Detailed",1:" Summary")
87 I SDWLOPEN W !,"Printing 'OPEN' Entries Only."
88 S %=1 W !!,"Are these Parameters Correct " D YN^DICN I %=2 S SDWLERR=1 W !," This Report will NOT be queued to print."
89 I %-1 W !," This Report will NOT be queued and returning." S SDWLERR=2
90QUE ;Queue Report
91 Q
92HD W:$D(IOF) @IOF W !,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"
93 Q
94END Q
Note: See TracBrowser for help on using the repository browser.