source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARC1.m@ 836

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

initial load of WorldVistAEHR

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