source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARCR1.m@ 738

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1LRARCR1 ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-MAIN ;
2 ;;5.2;LAB SERVICE;**59**;August 31, 1995
3GO ;
4 G TRIAL
5EN ;
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
11LRINST ;
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
22TRIAL ; 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
31B D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
32C D COLL^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G A
33S D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
34A 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
40I D INSTR^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
41L ;
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
53ASK ;
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
62QUE ;
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
70EXIT ;
71 S LREND=1
72 D CLEAN^LRARCR4
73 Q
Note: See TracBrowser for help on using the repository browser.