source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRQ2.m@ 1071

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

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1SDWLRQ2 ;;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT PRIM CARE TEAM AND POSITION ASSIGNMENTS;06/12/2002 ; 29 Aug 2002 2:53 PM
2 ;;5.3;scheduling;**263,425,482**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;
12 ;
13 ;
14EN ;Header
15 N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
16 N SDTEAM,SDHIST,SDACTIVE
17 D HD
181 S SDWLINST="",SDWLERR=0,SDWLE=0 K ^TMP("SDWLRQ2",$J),DIC,DIR,DR,DIE
19 D INS G END:SDWLERR
202 D CAT G 1:SDWLERR
213 D OPEN G 2:SDWLERR
22 S ^TMP("SDWLRQ2",$J,"DATE")=""
234 I %=2 D DATE G 3:SDWLERR
246 D FORM G 4:SDWLERR,END:$D(DUOUT)
257 D DIS G EN:SDWLERR=1,END:SDWLERR=2
26 D QUE
27 Q
28INS ;Get Institution
29 S SDWLPROM="Select Institution ALL // ",SDWLERR=0
30IN W ! S DIC(0)="QEMA",DIC("A")=SDWLPROM,DIC=4,DIC("S")="I $D(^SCTM(404.51,""AINST"",+Y))" D ^DIC I Y<0,'SDWLE D
31 .S (SDWLINS,SDWLINST)="" F S SDWLINS=$O(^SCTM(404.51,"AINST",SDWLINS)) Q:SDWLINS="" S SDWLINST=SDWLINST_SDWLINS_";"
32 I X="^" S SDWLERR=1 Q
33 G IN2:Y<0,END:$D(DUOUT)
34 I Y="All"!(Y="")!(Y="all")!(Y="ALL") S ^TMP("SDWLRQ2",$J,"INS")=SDWLINST G IN3
35 S SDWLINST=SDWLINST_+Y_";",SDWLPROM="Another Institution: ",SDWLE=1 G IN
36IN2 S ^TMP("SDWLRQ2",$J,"INS")=SDWLINST
37IN3 Q
38DATE ;Date range selection
39 S %=1 W !,"Print Report for ALL dates? " D YN^DICN
40 I %=1 S ^TMP("SDWLRQ2",$J,"DATE")="ALL" G E1
41 Q:%=0
42 Q:%=-1
43 S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with Date Entered: " D ^%DT G E1:Y<1 S SDWLBDT=Y
44 S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT
45 I X["^" S SDWLERR=1 Q
46 G E1:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
47 I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
48 S ^TMP("SDWLRQ2",$J,"DATE")=SDWLBDT_"^"_SDWLEDT Q
49E1 Q
50CAT ;Report category selection
51 W !!," *** Report Category Selection ***" S SDWLERR=0
52 S SDWLERR=0,SDWLCAT="",DIR(0)="S0^1:Team;2:Position",DIR("L",1)=" 1. Team",DIR("L")=" 2. Position"
53 D ^DIR
54 I X="^" S SDWLERR=1 Q
55 S X=$S(X["T":"T",X["t":"T",X["P":"P",X["p":"P",X=1:"T",X=2:"P",1:"")
56 I X="" W *7," Invalid Selection." G CAT
57 W !!,"Select Category for Report Output",!
58 S SDWLX=$S(X="T":"Team: ALL/ ",X="P":"Position: ALL/ ")
59 S SDWLF=$S(X="T":404.51,X="P":404.57)
60 K DIR,DIC,DR
61 S ^TMP("SDWLRQ2",$J,"CT1")=X_"^"_SDWLF
62 S DIC("A")=SDWLX
63 I SDWLF=404.51 D
64 .S DIC("S")="I $$ACTIVE^SDWLRQ2(Y),SDWLINST[+$P($G(^SCTM(404.51,+Y,0)),""^"",7)"
65CT1 W ! S DIC(0)="QEMNZA",DIC=SDWLF D ^DIC
66 I X="^" S SDWLERR=1 Q
67 I Y<1,SDWLCAT="" S ^TMP("SDWLRQ2",$J,"CT2")="ALL" G CT3
68 I Y<0,'$D(^TMP("SDWLRQ2",$J,"CT1")) W !,"This Entry is Required." G CAT
69 G CT2:Y<0
70 S SDWLCAT=SDWLCAT_Y_";",DIC("A")="Another "_$P(SDWLX,":",1)_": ",SDWLE=1 G CT1
71CT2 G CT1:'$D(SDWLCAT) S ^TMP("SDWLRQ2",$J,"CT2")=SDWLCAT
72CT3 Q
73OPEN ;OPEN Wait List Entries
74 S %=1 W !!,"Do you want only 'OPEN' Wait List Entries " D YN^DICN
75 I '% W *7,"Must Enter 'YES' or 'NO'." G OPEN
76 I %=-1 S SDWLERR=1
77 S ^TMP("SDWLRQ2",$J,"OPEN")=$S(%=1:"O",1:"C")
78 Q
79FORM ;Report Format
80 S SDWLERR=0,DIR(0)="SO^1:Detailed;2:Summary",DIR("L",2)=" 1. Detailed"
81 S DIR("L")=" 2. Summary",DIR("L",1)="Select One of the Following: "
82 D ^DIR
83 I X="^" S DUOUT=1 Q
84 S X=$S(X["S":"S",X["s":"S",X["D":"D",X["d":"D",X=1:"D",X=2:"S",1:"")
85 I X="" W *7," Invalid Response" G FORM
86 S ^TMP("SDWLRQ2",$J,"FORM")=X
87 Q
88DIS ;Display Parameters
89 S SDWLERR=0 W !!,?80-$L("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters ***",!
90 F SDWLI="INS","CT1","CT2","FORM","OPEN" D
91 .S X="SDWL"_SDWLI,@X=$G(^TMP("SDWLRQ2",$J,SDWLI))
92 F SDWLTAG="IS","CT","OP","PR" D @SDWLTAG
93 Q
94IS I SDWLINS'["ALL" D
95 .K SDWLY F I=1:1 S SDWLY=$P($P(SDWLINS,";",I),U,1) Q:SDWLY="" S SDWLY(I)=SDWLY
96 .W !,?20,"Institution: "
97 .I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?33 W $P($G(^DIC(4,SDWLY(I),0)),U,1)
98 .K SDWLY
99 I SDWLINS["ALL" W !,?20,"Institution: ALL "
100 Q
101CT I SDWLCT2'["ALL" D
102 .S SDWLF=$P(SDWLCT1,U,2)
103 .K SDWLY F I=1:1 S SDWLY=$P($P(SDWLCT2,";",I),U,2) Q:SDWLY="" S SDWLY(I)=SDWLY
104 .W !,?16,"Report Category: " W $S(SDWLCT1["T":"Team",1:"Position"),!,?36 I @X="ALL" W "All "
105 .I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?35 W $$EXTERNAL^DILFD(SDWLF,.01,,SDWLY(I))
106 I SDWLCT2["ALL" W !,?16,"Report Category: " W $S(SDWLCT1["T":"Team",1:"Position"),!,?36 W "ALL "
107 Q
108OP W !,?18,"Output Format: ",$S(SDWLFORM="D":" Detailed",1:" Summary")
109 Q
110PR I SDWLOPEN="O" W !,?25,"Printing 'OPEN' Entries Only."
111 E W !,?25,"Printing ALL Entries."
112 S %=1 W !!,"Are these Parameters Correct " D YN^DICN I %=2 S SDWLERR=1 W !," This Report will NOT be queued to print."
113 I SDWLERR S DIR(0)="E" D ^DIR I X["^" S SDWLERR=2
114 Q
115ACTIVE(Y) ;Active Team
116 S SDTEAM="",SDHIST="",SDACTIVE=""
117 I SDWLF="404.51" D
118 .S SDHIST=$O(^SCTM(404.58,"B",+Y,SDHIST),-1)
119 .S SDACTIVE=$P($G(^SCTM(404.58,+SDHIST,0)),"^",3)
120 Q +SDACTIVE
121QUE ;Queue Report
122 N ZTQUEUED,POP
123 K %ZIS,IOP,IOC,ZTIO,SDWLSPT S %ZIS="MQ" D ^%ZIS G:POP QUE1
124 S ZTRTN=$S(SDWLFORM="D":"EN^SDWLRPT2",1:"EN^SDWLRPS2"),ZTDTH=$H,ZTDESC="WAIT LIST REPORT FORMAT 2"
125 S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLRQ2",$J,SDWLTASK)) Q:SDWLTASK="" D
126 .S SDWLTK=$G(^TMP("SDWLRQ2",$J,SDWLTASK))
127 .S ZTSAVE(SDWLTASK)=SDWLTK
128 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G END
129QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT
130 ;
131END K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
132 K DIR,DIC,DR,DIE,SDWLSPT,I
133 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
134 Q
135HD W:$D(IOF) @IOF W !,?80-$L("Primary Care Team/Position Assignment Wait List Report")\2,"Primary Care Team/Position Assignment Wait List Report"
Note: See TracBrowser for help on using the repository browser.