Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRARCR1

LRARCR1.m

Go to the documentation of this file.
  1. LRARCR1 ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-MAIN ;
  1. ;;5.2;LAB SERVICE;**59**;August 31, 1995
  1. GO ;
  1. G TRIAL
  1. EN ;
  1. K DIC,%DT,^TMP("LRAR",$J),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC
  1. K LRSITSEL,DIR
  1. S (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LREND)=0
  1. S LRIOPAT=""
  1. Q
  1. LRINST ;
  1. S LRSITNUM=+$P($G(^XMB(1,1,"XUS")),U,17)
  1. S LRSITE=$P($G(^DIC(4,LRSITNUM,0)),U) S:LRSITE="" LRSITE="UNKNOWN"
  1. S LRSITSEL=0 K DIR S DIR(0)="S^Y:YES;N:NO"
  1. S DIR("A")="Do you want to print a specific DIVISION?"
  1. 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."
  1. D ^DIR Q:$D(DUOUT)!($D(DTOUT))
  1. I Y="N" Q
  1. S DIC("A")="Select a Division:",DIC=4,DIC(0)="AEMQ"
  1. 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)
  1. Q
  1. TRIAL ; entry point for work load lookup
  1. D EN,LRINST G:$D(DUOUT)!($D(DTOUT)) EXIT K DIR
  1. D ACCN^LRARCR1A G:Y<0 EXIT
  1. D DATE^LRARCR1A G:Y<0 EXIT S %=2
  1. W !,"Do you want to look up by Specimen Type and/or Collection Sample"
  1. D YN^DICN G:%<0 EXIT G:%=2 A
  1. S DIR(0)="S^S:SPECIMEN TYPE;C:COLLECTION SAMPLE;B:BOTH;A:ALL or ANY (Will not prompt)"
  1. S DIR("?")="<All> will not prompt for a specimen or sample"
  1. D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT G @Y
  1. B D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
  1. C D COLL^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G A
  1. S D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
  1. A W !,"Do you want to select by TESTS or WKLD CODES (YES or NO )"
  1. S %=2 D YN^DICN G:%=-1 EXIT
  1. G:%=2 I D ASK G:$D(DUOUT)!($D(DTOUT)) EXIT K DIC,DIR
  1. I Y="A" G L
  1. I Y="W" D CAP^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G L
  1. D TEST^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
  1. I D INSTR^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
  1. L ;
  1. D STAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT))!(%<0) EXIT
  1. D LOC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
  1. D IOPAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
  1. D CONTROL^LRARCR1A G:LREND EXIT
  1. D REPTYP^LRARCR1A G:LREND EXIT
  1. K DIR S DIR(0)="SX^D:DETAILED;C:CONDENSED",DIR("A")=" REPORT"
  1. D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT S LRANS=Y K DIR
  1. K IO("Q") S %ZIS="Q" D ^%ZIS G:POP EXIT I $D(IO("Q")) G QUE
  1. D WAIT^DICD
  1. U IO D ^LRARCR2
  1. Q
  1. ASK ;
  1. 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"
  1. S DIR("?")="All means no specified TEST or WKLD code is desired and will take you to the next prompt."
  1. S DIR("?",1)="You can only select either by TESTs or by WKLD CODEs"
  1. S DIR("?",2)="Choosing ALL will take you to the location prompt right away."
  1. S DIR("?",3)="Selecting by WLKD codes will limit you to a particular test only,"
  1. S DIR("?",4)="whereas by TEST might give you 1 or more WKLD codes."
  1. D ^DIR
  1. Q
  1. QUE ;
  1. S ZTSAVE("LR*")="",ZTRTN="LRARCR2",ZTDESC="ARCHIVED WORKLOAD REPORT",ZTIO=ION
  1. S:$G(LRSITE) ZTSAVE("LRSITE*")=""
  1. S:$G(LRSP) ZTSAVE("LRSP*")="" S:$G(LRCOL) ZTSAVE("LRCOL*")=""
  1. S:$G(LRTST) ZTSAVE("LRTST*")="" S:$G(LRCAPS) ZTSAVE("LRCAPS*")=""
  1. S:$G(LRCPSX) ZTSAVE("LRCPSX*")="" S:$G(LRLOC) ZTSAVE("LRLOC*")=""
  1. D ^%ZTLOAD,^%ZISC
  1. S LREND=1
  1. EXIT ;
  1. S LREND=1
  1. D CLEAN^LRARCR4
  1. Q