LRCAPR1 ;DALOI/PAC/FHS/JBM - WKLD REP GENERATOR-MAIN ;10/15/92 11:15
;;5.2;LAB SERVICE;**263**;Sep 27, 1994
GO ;
G TRIAL
EN ;
K DIC,%DT,^TMP("LR",$J),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LRLDIV
K LRSITSEL,DIR
S (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLDIV,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."
S DIR("B")="NO"
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^LRCAPR1A G:Y<0 EXIT
D DATE^LRCAPR1A 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^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
C D COLL^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G A
S D SPEC^LRCAPR1A 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^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT G L
D TEST^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
I D INSTR^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
L ;
D STAT^LRCAPR1A G:$D(DUOUT)!($D(DTOUT))!(%<0) EXIT
LOC ;
D G:$D(DUOUT)!($D(DTOUT)) EXIT
. N DIR S DIR(0)="YO",DIR("A")="Do you want to select Hospital Location ",DIR("B")="Yes"
. D ^DIR I Y'=1 S LRLOC="1A" Q
. D LOC^LRCAPR1A
LEDIDIV ;Select LEDI Institution sites
INST D G:$D(DUOUT)!($D(DTOUT)) EXIT
. N DIR,DIC
. I LRLOC="1A" S DIR("B")="Yes"
. S DIR(0)="YO",DIR("A")="Do you want to select LEDI Collecting Sites "
. D ^DIR I Y'=1 S LRLDIV="1A" Q
. S DIC=4,DIC(0)="AEMQ",DIC("A")="Select LEDI Collecting Sites : All // "
. F I=1:1 D ^DIC Q:Y=-1 S LRLDIV(+Y)=$P(^(0),U),DIC("A")="Select another Site: ",LRLDIV=I
I LRLDIV="1A",LRLOC="1A" D G LOC
. W !!?5,"<You HAVEN'T selected any locations> "
. S (LRLOC,LRLDIV)=0
D IOPAT^LRCAPR1A G:$D(DUOUT)!($D(DTOUT)) EXIT
D CONTROL^LRCAPR1A G:LREND EXIT
D REPTYP^LRCAPR1A 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 ^LRCAPR2
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="LRCAPR2",ZTDESC="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*")=""
S:$G(LRLDIV) ZTSAVE("LRLDIV")=""
D ^%ZTLOAD,^%ZISC
S LREND=1
EXIT ;
S LREND=1
D CLEAN^LRCAPR4 K LRLDIV,LREDT,LRSDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPR1 3980 printed Nov 22, 2024@17:23:20 Page 2
LRCAPR1 ;DALOI/PAC/FHS/JBM - WKLD REP GENERATOR-MAIN ;10/15/92 11:15
+1 ;;5.2;LAB SERVICE;**263**;Sep 27, 1994
GO ;
+1 GOTO TRIAL
EN ;
+1 KILL DIC,%DT,^TMP("LR",$JOB),LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLOC,LRLDIV
+2 KILL LRSITSEL,DIR
+3 SET (LRCOL,LRCPSX,LRCAPS,LRTSTS,LRSP,LRLDIV,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 SET DIR("B")="NO"
+7 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+8 IF Y="N"
QUIT
+9 SET DIC("A")="Select a Division:"
SET DIC=4
SET DIC(0)="AEMQ"
+10 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)
+11 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^LRCAPR1A
if Y<0
GOTO EXIT
+3 DO DATE^LRCAPR1A
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^LRCAPR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
C DO COLL^LRCAPR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
GOTO A
S DO SPEC^LRCAPR1A
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^LRCAPR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
GOTO L
+5 DO TEST^LRCAPR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
I DO INSTR^LRCAPR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
L ;
+1 DO STAT^LRCAPR1A
if $DATA(DUOUT)!($DATA(DTOUT))!(%<0)
GOTO EXIT
LOC ;
+1 Begin DoDot:1
+2 NEW DIR
SET DIR(0)="YO"
SET DIR("A")="Do you want to select Hospital Location "
SET DIR("B")="Yes"
+3 DO ^DIR
IF Y'=1
SET LRLOC="1A"
QUIT
+4 DO LOC^LRCAPR1A
End DoDot:1
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
LEDIDIV ;Select LEDI Institution sites
INST Begin DoDot:1
+1 NEW DIR,DIC
+2 IF LRLOC="1A"
SET DIR("B")="Yes"
+3 SET DIR(0)="YO"
SET DIR("A")="Do you want to select LEDI Collecting Sites "
+4 DO ^DIR
IF Y'=1
SET LRLDIV="1A"
QUIT
+5 SET DIC=4
SET DIC(0)="AEMQ"
SET DIC("A")="Select LEDI Collecting Sites : All // "
+6 FOR I=1:1
DO ^DIC
if Y=-1
QUIT
SET LRLDIV(+Y)=$PIECE(^(0),U)
SET DIC("A")="Select another Site: "
SET LRLDIV=I
End DoDot:1
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
+7 IF LRLDIV="1A"
IF LRLOC="1A"
Begin DoDot:1
+8 WRITE !!?5,"<You HAVEN'T selected any locations> "
+9 SET (LRLOC,LRLDIV)=0
End DoDot:1
GOTO LOC
+10 DO IOPAT^LRCAPR1A
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
+11 DO CONTROL^LRCAPR1A
if LREND
GOTO EXIT
+12 DO REPTYP^LRCAPR1A
if LREND
GOTO EXIT
+13 KILL DIR
SET DIR(0)="SX^D:DETAILED;C:CONDENSED"
SET DIR("A")=" REPORT"
+14 DO ^DIR
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
SET LRANS=Y
KILL DIR
+15 KILL IO("Q")
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
GOTO QUE
+16 DO WAIT^DICD
+17 USE IO
DO ^LRCAPR2
+18 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="LRCAPR2"
SET ZTDESC="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 if $GET(LRLDIV)
SET ZTSAVE("LRLDIV")=""
+7 DO ^%ZTLOAD
DO ^%ZISC
+8 SET LREND=1
EXIT ;
+1 SET LREND=1
+2 DO CLEAN^LRCAPR4
KILL LRLDIV,LREDT,LRSDT
+3 QUIT
