| 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 | 
|---|