LRARCR1 ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-MAIN ;
;;5.2;LAB SERVICE;**59**;August 31, 1995
GO ;
G TRIAL
EN ;
K DIC,%DT,^TMP("LRAR",$J),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC
K LRSITSEL,DIR
S (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LREND)=0
S LRIOPAT=""
Q
LRINST ;
S LRSITNUM=+$P($G(^XMB(1,1,"XUS")),U,17)
S LRSITE=$P($G(^DIC(4,LRSITNUM,0)),U) S:LRSITE="" LRSITE="UNKNOWN"
S LRSITSEL=0 K DIR S DIR(0)="S^Y:YES;N:NO"
S DIR("A")="Do you want to print a specific DIVISION?"
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."
D ^DIR Q:$D(DUOUT)!($D(DTOUT))
I Y="N" Q
S DIC("A")="Select a Division:",DIC=4,DIC(0)="AEMQ"
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)
Q
TRIAL ; entry point for work load lookup
D EN,LRINST G:$D(DUOUT)!($D(DTOUT)) EXIT K DIR
D ACCN^LRARCR1A G:Y<0 EXIT
D DATE^LRARCR1A G:Y<0 EXIT S %=2
W !,"Do you want to look up by Specimen Type and/or Collection Sample"
D YN^DICN G:%<0 EXIT G:%=2 A
S DIR(0)="S^S:SPECIMEN TYPE;C:COLLECTION SAMPLE;B:BOTH;A:ALL or ANY (Will not prompt)"
S DIR("?")="<All> will not prompt for a specimen or sample"
D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT G @Y
B D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
C D COLL^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G A
S D SPEC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
A W !,"Do you want to select by TESTS or WKLD CODES (YES or NO )"
S %=2 D YN^DICN G:%=-1 EXIT
G:%=2 I D ASK G:$D(DUOUT)!($D(DTOUT)) EXIT K DIC,DIR
I Y="A" G L
I Y="W" D CAP^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G L
D TEST^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
I D INSTR^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
L ;
D STAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT))!(%<0) EXIT
D LOC^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
D IOPAT^LRARCR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
D CONTROL^LRARCR1A G:LREND EXIT
D REPTYP^LRARCR1A G:LREND EXIT
K DIR S DIR(0)="SX^D:DETAILED;C:CONDENSED",DIR("A")=" REPORT"
D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT S LRANS=Y K DIR
K IO("Q") S %ZIS="Q" D ^%ZIS G:POP EXIT I $D(IO("Q")) G QUE
D WAIT^DICD
U IO D ^LRARCR2
Q
ASK ;
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"
S DIR("?")="All means no specified TEST or WKLD code is desired and will take you to the next prompt."
S DIR("?",1)="You can only select either by TESTs or by WKLD CODEs"
S DIR("?",2)="Choosing ALL will take you to the location prompt right away."
S DIR("?",3)="Selecting by WLKD codes will limit you to a particular test only,"
S DIR("?",4)="whereas by TEST might give you 1 or more WKLD codes."
D ^DIR
Q
QUE ;
S ZTSAVE("LR*")="",ZTRTN="LRARCR2",ZTDESC="ARCHIVED WORKLOAD REPORT",ZTIO=ION
S:$G(LRSITE) ZTSAVE("LRSITE*")=""
S:$G(LRSP) ZTSAVE("LRSP*")="" S:$G(LRCOL) ZTSAVE("LRCOL*")=""
S:$G(LRTST) ZTSAVE("LRTST*")="" S:$G(LRCAPS) ZTSAVE("LRCAPS*")=""
S:$G(LRCPSX) ZTSAVE("LRCPSX*")="" S:$G(LRLOC) ZTSAVE("LRLOC*")=""
D ^%ZTLOAD,^%ZISC
S LREND=1
EXIT ;
S LREND=1
D CLEAN^LRARCR4
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCR1 3241 printed Dec 13, 2024@02:09:16 Page 2
LRARCR1 ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-MAIN ;
+1 ;;5.2;LAB SERVICE;**59**;August 31, 1995
GO ;
+1 GOTO TRIAL
EN ;
+1 KILL DIC,%DT,^TMP("LRAR",$JOB),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC
+2 KILL LRSITSEL,DIR
+3 SET (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LREND)=0
+4 SET LRIOPAT=""
+5 QUIT
LRINST ;
+1 SET LRSITNUM=+$PIECE($GET(^XMB(1,1,"XUS")),U,17)
+2 SET LRSITE=$PIECE($GET(^DIC(4,LRSITNUM,0)),U)
if LRSITE=""
SET LRSITE="UNKNOWN"
+3 SET LRSITSEL=0
KILL DIR
SET DIR(0)="S^Y:YES;N:NO"
+4 SET DIR("A")="Do you want to print a specific DIVISION?"
+5 SET 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."
+6 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+7 IF Y="N"
QUIT
+8 SET DIC("A")="Select a Division:"
SET DIC=4
SET DIC(0)="AEMQ"
+9 FOR
DO ^DIC
if Y=-1
QUIT
SET LRSITSEL=+Y
SET LRSITSEL(+Y)=$SELECT($LENGTH($PIECE($GET(^DIC(4,+Y,0)),U)):$PIECE(^(0),U),1:"ERROR"_Y)
+10 QUIT
TRIAL ; entry point for work load lookup
+1 DO EN
DO LRINST
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
KILL DIR
+2 DO ACCN^LRARCR1A
if Y<0
GOTO EXIT
+3 DO DATE^LRARCR1A
if Y<0
GOTO EXIT
SET %=2
+4 WRITE !,"Do you want to look up by Specimen Type and/or Collection Sample"
+5 DO YN^DICN
if %<0
GOTO EXIT
if %=2
GOTO A
+6 SET DIR(0)="S^S:SPECIMEN TYPE;C:COLLECTION SAMPLE;B:BOTH;A:ALL or ANY (Will not prompt)"
+7 SET DIR("?")="<All> will not prompt for a specimen or sample"
+8 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
GOTO @Y
B DO SPEC^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
C DO COLL^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
GOTO A
S DO SPEC^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
A WRITE !,"Do you want to select by TESTS or WKLD CODES (YES or NO )"
+1 SET %=2
DO YN^DICN
if %=-1
GOTO EXIT
+2 if %=2
GOTO I
DO ASK
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
KILL DIC,DIR
+3 IF Y="A"
GOTO L
+4 IF Y="W"
DO CAP^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
GOTO L
+5 DO TEST^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
I DO INSTR^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
L ;
+1 DO STAT^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))!(%<0)
GOTO EXIT
+2 DO LOC^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
+3 DO IOPAT^LRARCR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
+4 DO CONTROL^LRARCR1A
if LREND
GOTO EXIT
+5 DO REPTYP^LRARCR1A
if LREND
GOTO EXIT
+6 KILL DIR
SET DIR(0)="SX^D:DETAILED;C:CONDENSED"
SET DIR("A")=" REPORT"
+7 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
SET LRANS=Y
KILL DIR
+8 KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
GOTO QUE
+9 DO WAIT^DICD
+10 USE IO
DO ^LRARCR2
+11 QUIT
ASK ;
+1 SET DIR(0)="S^T:TEST;W:WKLD CODE;A:ALL (means no specific TEST or WKLD CODE )"
SET DIR("A")="Do you want to select by (T)est or (W)KLD Code or (A)ll"
+2 SET DIR("?")="All means no specified TEST or WKLD code is desired and will take you to the next prompt."
+3 SET DIR("?",1)="You can only select either by TESTs or by WKLD CODEs"
+4 SET DIR("?",2)="Choosing ALL will take you to the location prompt right away."
+5 SET DIR("?",3)="Selecting by WLKD codes will limit you to a particular test only,"
+6 SET DIR("?",4)="whereas by TEST might give you 1 or more WKLD codes."
+7 DO ^DIR
+8 QUIT
QUE ;
+1 SET ZTSAVE("LR*")=""
SET ZTRTN="LRARCR2"
SET ZTDESC="ARCHIVED WORKLOAD REPORT"
SET ZTIO=ION
+2 if $GET(LRSITE)
SET ZTSAVE("LRSITE*")=""
+3 if $GET(LRSP)
SET ZTSAVE("LRSP*")=""
if $GET(LRCOL)
SET ZTSAVE("LRCOL*")=""
+4 if $GET(LRTST)
SET ZTSAVE("LRTST*")=""
if $GET(LRCAPS)
SET ZTSAVE("LRCAPS*")=""
+5 if $GET(LRCPSX)
SET ZTSAVE("LRCPSX*")=""
if $GET(LRLOC)
SET ZTSAVE("LRLOC*")=""
+6 DO ^%ZTLOAD
DO ^%ZISC
+7 SET LREND=1
EXIT ;
+1 SET LREND=1
+2 DO CLEAN^LRARCR4
+3 QUIT
