Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRRP7

LRRP7.m

Go to the documentation of this file.
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