| [613] | 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
 | 
|---|