1 | LRARCR1 ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-MAIN ;
|
---|
2 | ;;5.2;LAB SERVICE;**59**;August 31, 1995
|
---|
3 | GO ;
|
---|
4 | G TRIAL
|
---|
5 | EN ;
|
---|
6 | K DIC,%DT,^TMP("LRAR",$J),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC
|
---|
7 | K LRSITSEL,DIR
|
---|
8 | S (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LREND)=0
|
---|
9 | S LRIOPAT=""
|
---|
10 | Q
|
---|
11 | LRINST ;
|
---|
12 | S LRSITNUM=+$P($G(^XMB(1,1,"XUS")),U,17)
|
---|
13 | S LRSITE=$P($G(^DIC(4,LRSITNUM,0)),U) S:LRSITE="" LRSITE="UNKNOWN"
|
---|
14 | S LRSITSEL=0 K DIR S DIR(0)="S^Y:YES;N:NO"
|
---|
15 | S DIR("A")="Do you want to print a specific DIVISION?"
|
---|
16 | S DIR("?")="If you have a multi-divisional institution you might want to print a particular division, otherwise your report will reflect the whole instution which might not be what you have intended."
|
---|
17 | D ^DIR Q:$D(DUOUT)!($D(DTOUT))
|
---|
18 | I Y="N" Q
|
---|
19 | S DIC("A")="Select a Division:",DIC=4,DIC(0)="AEMQ"
|
---|
20 | F D ^DIC Q:Y=-1 S LRSITSEL=+Y,LRSITSEL(+Y)=$S($L($P($G(^DIC(4,+Y,0)),U)):$P(^(0),U),1:"ERROR"_Y)
|
---|
21 | Q
|
---|
22 | TRIAL ; entry point for work load lookup
|
---|
23 | D EN,LRINST G:$D(DUOUT)!($D(DTOUT)) EXIT K DIR
|
---|
24 | D ACCN^LRARCR1A G:Y<0 EXIT
|
---|
25 | D DATE^LRARCR1A G:Y<0 EXIT S %=2
|
---|
26 | W !,"Do you want to look up by Specimen Type and/or Collection Sample"
|
---|
27 | D YN^DICN G:%<0 EXIT G:%=2 A
|
---|
28 | S DIR(0)="S^S:SPECIMEN TYPE;C:COLLECTION SAMPLE;B:BOTH;A:ALL or ANY (Will not prompt)"
|
---|
29 | S DIR("?")="<All> will not prompt for a specimen or sample"
|
---|
30 | D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT G @Y
|
---|
31 | B D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
|
---|
32 | C D COLL^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G A
|
---|
33 | S D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
|
---|
34 | A W !,"Do you want to select by TESTS or WKLD CODES (YES or NO )"
|
---|
35 | S %=2 D YN^DICN G:%=-1 EXIT
|
---|
36 | G:%=2 I D ASK G:$D(DUOUT)!($D(DTOUT)) EXIT K DIC,DIR
|
---|
37 | I Y="A" G L
|
---|
38 | I Y="W" D CAP^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G L
|
---|
39 | D TEST^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
|
---|
40 | I D INSTR^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
|
---|
41 | L ;
|
---|
42 | D STAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT))!(%<0) EXIT
|
---|
43 | D LOC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
|
---|
44 | D IOPAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
|
---|
45 | D CONTROL^LRARCR1A G:LREND EXIT
|
---|
46 | D REPTYP^LRARCR1A G:LREND EXIT
|
---|
47 | K DIR S DIR(0)="SX^D:DETAILED;C:CONDENSED",DIR("A")=" REPORT"
|
---|
48 | D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT S LRANS=Y K DIR
|
---|
49 | K IO("Q") S %ZIS="Q" D ^%ZIS G:POP EXIT I $D(IO("Q")) G QUE
|
---|
50 | D WAIT^DICD
|
---|
51 | U IO D ^LRARCR2
|
---|
52 | Q
|
---|
53 | ASK ;
|
---|
54 | S DIR(0)="S^T:TEST;W:WKLD CODE;A:ALL (means no specific TEST or WKLD CODE )",DIR("A")="Do you want to select by (T)est or (W)KLD Code or (A)ll"
|
---|
55 | S DIR("?")="All means no specified TEST or WKLD code is desired and will take you to the next prompt."
|
---|
56 | S DIR("?",1)="You can only select either by TESTs or by WKLD CODEs"
|
---|
57 | S DIR("?",2)="Choosing ALL will take you to the location prompt right away."
|
---|
58 | S DIR("?",3)="Selecting by WLKD codes will limit you to a particular test only,"
|
---|
59 | S DIR("?",4)="whereas by TEST might give you 1 or more WKLD codes."
|
---|
60 | D ^DIR
|
---|
61 | Q
|
---|
62 | QUE ;
|
---|
63 | S ZTSAVE("LR*")="",ZTRTN="LRARCR2",ZTDESC="ARCHIVED WORKLOAD REPORT",ZTIO=ION
|
---|
64 | S:$G(LRSITE) ZTSAVE("LRSITE*")=""
|
---|
65 | S:$G(LRSP) ZTSAVE("LRSP*")="" S:$G(LRCOL) ZTSAVE("LRCOL*")=""
|
---|
66 | S:$G(LRTST) ZTSAVE("LRTST*")="" S:$G(LRCAPS) ZTSAVE("LRCAPS*")=""
|
---|
67 | S:$G(LRCPSX) ZTSAVE("LRCPSX*")="" S:$G(LRLOC) ZTSAVE("LRLOC*")=""
|
---|
68 | D ^%ZTLOAD,^%ZISC
|
---|
69 | S LREND=1
|
---|
70 | EXIT ;
|
---|
71 | S LREND=1
|
---|
72 | D CLEAN^LRARCR4
|
---|
73 | Q
|
---|