Routine: LRCAPR1

LRCAPR1 ;DALOI/PAC/FHS/JBM - WKLD REP GENERATOR-MAIN ;10/15/92 11:15

 ;;5.2T9;LR;**1018**;Nov 17, 2004

 ;;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=""

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)

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

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

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

LRCAPR1   ;DALOI/PAC/FHS/JBM - WKLD REP GENERATOR-MAIN ;10/15/92 11:15

 +1       ;;5.2T9;LR;**1018**;Nov 17, 2004

 +2       ;;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

LRCAPR1.m