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

LRRP8A.m

Go to the documentation of this file.
  1. LRRP8A ;DALISC/TNN/J0 - WKLD STATS REPORT BY SHIFT ; 4/9/93
  1. ;;5.2;LAB SERVICE;**63**;Sep 27, 1994
  1. W !!,"ENTRY POINT IS AT EN^LRRP8." H 3 QUIT
  1. ;
  1. ASK ;
  1. D INST Q:LREND
  1. D ACCAREA Q:LREND
  1. D DATES Q:LREND
  1. D CAPS Q:LREND
  1. D TIMES Q:LREND
  1. D REPTYP Q:LREND
  1. D DEVICE Q:LREND
  1. Q
  1. INST ;*** Query for institution ***
  1. K DIC
  1. W @IOF,!
  1. S DIC="^LRO(64.1,",DIC(0)="AQENM" D ^DIC
  1. I (+Y<0)!($D(DUOUT))!($D(DTOUT)) S LREND=1 Q
  1. S LRIN=+Y
  1. Q
  1. ACCAREA ;*** Query for accession areas ***
  1. S LRAA=0
  1. K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
  1. S DIR("A")="Do you want to select accession areas (YES or NO) "
  1. S DIR("?",1)="Enter 'NO' to include ALL accession areas."
  1. S DIR("?")="Enter 'YES' to limit report to one or more accession areas."
  1. D ^DIR
  1. Q:Y="N"
  1. I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
  1. K DIC S DIC=68,DIC(0)="AEMQZ"
  1. F D ^DIC Q:Y=-1 D
  1. .S LRAA=+Y,LRAA(+Y)=$P(Y(0),U,11)
  1. I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
  1. Q
  1. DATES ;*** Query for date ***
  1. W !,"DATE selection:"
  1. K DIR,X,Y S DIR(0)="S^1:A specific date;2:A range of dates"
  1. D ^DIR
  1. I $D(DIRUT)!($D(DUOUT)) S LREND=1 Q
  1. I X=1 D QDT Q
  1. D DATE^LRCAPR1A S:Y=-1 LREND=1
  1. Q
  1. CAPS ;*** Query for CAP codes ***
  1. N I S LRCAPS=0 K DIR,X,Y
  1. S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
  1. S DIR("A")="Do you want to select workload codes (YES or NO) "
  1. S DIR("?",1)="Enter 'NO' to include ALL workload codes."
  1. S DIR("?")="Enter 'YES' to limit report to one or more workload codes."
  1. D ^DIR
  1. Q:Y="N"
  1. I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
  1. W !
  1. S DIC="^LAM(",DIC(0)="AQENM",DIC("A")="Select WKLD code:"
  1. F I=1:1 D ^DIC Q:Y=-1 S LRCAPS(+Y)=$P(Y,U),LRCAPS=I
  1. S:($D(DTOUT))!($D(DUOUT)) LREND=1
  1. Q
  1. TIMES ;*** Query for type of time search ***
  1. W !,"TIME selection:"
  1. K DIR S DIR(0)="S^1:A time range;2:A set of shifts"
  1. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
  1. I X=2 D QST Q
  1. D QTR I ($G(LRSTRT)<0)!($G(LRSTOP)<0) S LREND=1
  1. Q
  1. REPTYP ;*** Query for type of type of report ***
  1. W !,"REPORT selection:"
  1. K DIR S DIR(0)="S^1:Detail report;2:Summary report"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
  1. S LRRPT=+X
  1. Q
  1. DEVICE ;
  1. K %ZIS,POP S %ZIS="Q" D ^%ZIS
  1. I POP S LREND=1 Q
  1. I $D(IO("Q")) D QUE S LREND=1
  1. Q
  1. QUE ;
  1. S ZTSAVE("LR*")="",ZTRTN="DQ^LRRP8",ZTDESC="LR WKLD SHIFT REPORT"
  1. S:$G(LRAA) ZTSAVE("LRAA*")=""
  1. D ^%ZTLOAD,^%ZISC
  1. W:$G(ZTSK) !!,"TASK ",ZTSK," QUEUED." H 3
  1. Q
  1. QDT ;*** Query for a specific date ***
  1. W !
  1. S DIC="^LRO(64.1,"_LRIN_",1,",DIC(0)="AQENM" D ^DIC
  1. I Y=-1 S LREND=1 Q
  1. S (LRDATE,LRFR,LRTO)=+Y,LRDR=1 D DD^%DT
  1. S LRDTH="For: "_Y
  1. Q
  1. QST ;*** Query for shifts ***
  1. N I3
  1. S LRSTFLG=1 W !,"How many shifts?"
  1. K DIR S DIR(0)="N^1:4:0"
  1. D ^DIR K DIR S LRNSFT=X I $D(DIRUT)!($D(DUOUT)) S LREND=1 Q
  1. F I3=1:1:LRNSFT D Q:LREND
  1. . W !!,"For Shift # ",I3
  1. . D QTR Q:LREND=1
  1. . S LRST(I3)=LRSTRT_"^"_LRSTOP
  1. Q
  1. QTR ;*** Query for a time range (in military format) ***
  1. W !,"Enter TIME RANGE in military format HHMM.SS (0.00 - 2400.00):"
  1. K DIR S DIR(0)="LO^0.00:2400.00",DIR("A")="START time: "
  1. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
  1. S LRSTRT=X S:+LRSTRT=0 LRSTRT=.01 I LRSTRT="" G QTR
  1. Q1 K DIR S DIR(0)="LO^0.00:2400.00",DIR("A")="STOP time: "
  1. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S LREND=1 Q
  1. S LRSTOP=X I LRSTOP="" G Q1
  1. I LRSTOP<LRSTRT W !,"Stop time should be GREATER than start time" G QTR
  1. Q