VistA-WorldVistAEHR/r/LAB_SERVICE-LR-LS/LRRP7.m

82 lines
2.2 KiB
Mathematica

LRRP7 ;DALISC/J0 - MANUAL WKLD STATS REPORT ;8/11/97
;;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