LRRP7 ; IHS/DIR/AAB - MANUAL WKLD STATS REPORT 8/11/97 ; [ 07/22/2002 1:41 PM ]
;;5.2;LR;**1003,1013**;JUL 15, 2002
;;5.2;LAB SERVICE;**1,63,121**;Sep 27, 1994
EN ;*** Entry point and control block ***
S LREND=0
D ASK
DQ ;
D:'LREND INIT
D:'LREND BUILD
D:'LREND PRNTMAN^LRCAPMR1
D CLN
Q
;
INIT ;*** Initialize some variables ***
K ^TMP("LR",$J)
U IO
W:$E(IOST,1,2)="C-" @IOF
D PRTINIT^LRCAPU
S LRHDR="WORKLOAD STATISTICS BY ACCESSION AREA AND SHIFTS"
S LRHDR2=LRDTH
Q
;
CLN ;*** Clean up ***
D ^%ZISC,PRTCLN^LRCAPU,WKLDCLN^LRCAPU,CLNMAN^LRCAPMR1
K ^TMP("LR",$J)
K LRCDT,LRFR,LRFRV,LRFRD,LRTO,LRTOV,LRTOD,LRDTH,LRDSH,LRSTRT,LRSTOP,LRUC
K LRCAPS,LRCC,LRCAPNAM,LRCAPNUM,LRCAPFLG,LRCAPIFN,LRA,LRAA,LRCCNT,LRANAM
K LRREC,LRTIM,LRRPT,LREND,LRST,LRSTFLG,LRNSFT,LRSHFT,LRIN,LRPCT,LRSCNT
K LRACNT,LRGCNT,LRCONT,LRSQRM,LRMNODE,LRGSTND,LRGQC,LRGRPT,LRGMANL,LRDR
K LRDATE,LRCOM,LRTCOM,LRCOMM,LRCM
K DIC,DIR,X,Y,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK,DTOUT,DUOUT,DIRUT
Q
ASK ;
D INST Q:LREND
D DATE^LRCAPR1A S:Y=-1 LREND=1
D CAPS Q:LREND
D DEVICE Q:LREND
Q
INST ;*** Query for institution ***
K DIC
W @IOF,!
S DIC="^LRO(64.1,",DIC(0)="AQENM" D ^DIC
I (+Y<0)!($D(DUOUT))!($D(DTOUT)) S LREND=1 Q
S LRIN=+Y
Q
CAPS ;*** Query for CAP codes ***
N I S LRCAPS=0 K DIR,X,Y
S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
S DIR("A")="Do you want to select workload codes (YES or NO) "
S DIR("?",1)="Enter 'NO' to include ALL workload codes."
S DIR("?")="Enter 'YES' to limit report to one or more workload codes."
D ^DIR
Q:Y="N"
I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
W !
S DIC="^LAM(",DIC(0)="AQENM",DIC("A")="Select WKLD code:"
F I=1:1 D ^DIC Q:Y=-1 S LRCAPS(+Y)=$P(Y,U),LRCAPS=I
S:($D(DTOUT))!($D(DUOUT)) LREND=1
Q
DEVICE ;
K %ZIS,POP S %ZIS="Q" D ^%ZIS
I POP S LREND=1 Q
I $D(IO("Q")) D QUE S LREND=1
Q
QUE ;
S ZTSAVE("LR*")="",ZTRTN="DQ^LRRP7",ZTDESC="LR MANUAL WKLD REPORT"
D ^%ZTLOAD,^%ZISC
W:$G(ZTSK) !!,"TASK ",ZTSK," QUEUED." H 3
Q
BUILD ;
N LRGCN,LRCCN,LRDCN,X
S ^TMP("LR",$J,0)=0
D INITMAN^LRCAPMR1
I LRTO>LRFR S X=LRFR,LRFR=LRTO,LRTO=X
S LRCDT=LRTO-1
F S LRCDT=$O(^LRO(64.1,LRIN,1,LRCDT)) Q:('LRCDT)!(LRCDT>LRFR) D
. S LRCC=0
. F S LRCC=$O(^LRO(64.1,LRIN,1,LRCDT,1,LRCC)) Q:'LRCC D
. . I LRCAPS Q:'$D(LRCAPS(LRCC))
. . S LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
. . D BMPMANL^LRCAPMR1
Q
LRRP7 ; IHS/DIR/AAB - MANUAL WKLD STATS REPORT 8/11/97 ; [ 07/22/2002 1:41 PM ]
+1 ;;5.2;LR;**1003,1013**;JUL 15, 2002
+2 ;;5.2;LAB SERVICE;**1,63,121**;Sep 27, 1994
EN ;*** Entry point and control block ***
+1 SET LREND=0
+2 DO ASK
DQ ;
+1 IF 'LREND
DO INIT
+2 IF 'LREND
DO BUILD
+3 IF 'LREND
DO PRNTMAN^LRCAPMR1
+4 DO CLN
+5 QUIT
+6 ;
INIT ;*** Initialize some variables ***
+1 KILL ^TMP("LR",$JOB)
+2 USE IO
+3 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+4 DO PRTINIT^LRCAPU
+5 SET LRHDR="WORKLOAD STATISTICS BY ACCESSION AREA AND SHIFTS"
+6 SET LRHDR2=LRDTH
+7 QUIT
+8 ;
CLN ;*** Clean up ***
+1 DO ^%ZISC
DO PRTCLN^LRCAPU
DO WKLDCLN^LRCAPU
DO CLNMAN^LRCAPMR1
+2 KILL ^TMP("LR",$JOB)
+3 KILL LRCDT,LRFR,LRFRV,LRFRD,LRTO,LRTOV,LRTOD,LRDTH,LRDSH,LRSTRT,LRSTOP,LRUC
+4 KILL LRCAPS,LRCC,LRCAPNAM,LRCAPNUM,LRCAPFLG,LRCAPIFN,LRA,LRAA,LRCCNT,LRANAM
+5 KILL LRREC,LRTIM,LRRPT,LREND,LRST,LRSTFLG,LRNSFT,LRSHFT,LRIN,LRPCT,LRSCNT
+6 KILL LRACNT,LRGCNT,LRCONT,LRSQRM,LRMNODE,LRGSTND,LRGQC,LRGRPT,LRGMANL,LRDR
+7 KILL LRDATE,LRCOM,LRTCOM,LRCOMM,LRCM
+8 KILL DIC,DIR,X,Y,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK,DTOUT,DUOUT,DIRUT
+9 QUIT
ASK ;
+1 DO INST
IF LREND
QUIT
+2 DO DATE^LRCAPR1A
IF Y=-1
SET LREND=1
+3 DO CAPS
IF LREND
QUIT
+4 DO DEVICE
IF LREND
QUIT
+5 QUIT
INST ;*** Query for institution ***
+1 KILL DIC
+2 WRITE @IOF,!
+3 SET DIC="^LRO(64.1,"
SET DIC(0)="AQENM"
DO ^DIC
+4 IF (+Y<0)!($DATA(DUOUT))!($DATA(DTOUT))
SET LREND=1
QUIT
+5 SET LRIN=+Y
+6 QUIT
CAPS ;*** Query for CAP codes ***
+1 NEW I
SET LRCAPS=0
KILL DIR,X,Y
+2 SET DIR(0)="S^Y:YES;N:NO"
SET DIR("B")="NO"
+3 SET DIR("A")="Do you want to select workload codes (YES or NO) "
+4 SET DIR("?",1)="Enter 'NO' to include ALL workload codes."
+5 SET DIR("?")="Enter 'YES' to limit report to one or more workload codes."
+6 DO ^DIR
+7 IF Y="N"
QUIT
+8 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+9 WRITE !
+10 SET DIC="^LAM("
SET DIC(0)="AQENM"
SET DIC("A")="Select WKLD code:"
+11 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET LRCAPS(+Y)=$PIECE(Y,U)
SET LRCAPS=I
+12 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
+13 QUIT
DEVICE ;
+1 KILL %ZIS,POP
SET %ZIS="Q"
DO ^%ZIS
+2 IF POP
SET LREND=1
QUIT
+3 IF $DATA(IO("Q"))
DO QUE
SET LREND=1
+4 QUIT
QUE ;
+1 SET ZTSAVE("LR*")=""
SET ZTRTN="DQ^LRRP7"
SET ZTDESC="LR MANUAL WKLD REPORT"
+2 DO ^%ZTLOAD
DO ^%ZISC
+3 IF $GET(ZTSK)
WRITE !!,"TASK ",ZTSK," QUEUED."
HANG 3
+4 QUIT
BUILD ;
+1 NEW LRGCN,LRCCN,LRDCN,X
+2 SET ^TMP("LR",$JOB,0)=0
+3 DO INITMAN^LRCAPMR1
+4 IF LRTO>LRFR
SET X=LRFR
SET LRFR=LRTO
SET LRTO=X
+5 SET LRCDT=LRTO-1
+6 FOR
SET LRCDT=$ORDER(^LRO(64.1,LRIN,1,LRCDT))
IF ('LRCDT)!(LRCDT>LRFR)
QUIT
Begin DoDot:1
+7 SET LRCC=0
+8 FOR
SET LRCC=$ORDER(^LRO(64.1,LRIN,1,LRCDT,1,LRCC))
IF 'LRCC
QUIT
Begin DoDot:2
+9 IF LRCAPS
IF '$DATA(LRCAPS(LRCC))
QUIT
+10 SET LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
+11 DO BMPMANL^LRCAPMR1
End DoDot:2
End DoDot:1
+12 QUIT
