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

LRRP6.m

Go to the documentation of this file.
  1. LRRP6 ;DALISC/J0 - LAB TEST/WORKLOAD CODE REPORTS ;12/07/92
  1. ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
  1. EN ;
  1. S LREND=0
  1. D SELECT
  1. D:'LREND DEVICE
  1. D:'LREND @ZTRTN
  1. D WRAPUP
  1. Q
  1. SELECT ;
  1. D SITE Q:LREND
  1. D DIV Q:LREND
  1. D DATES Q:LREND
  1. D METHOD Q:LREND
  1. D ACCAREA Q:LREND
  1. I ZTRTN="DQ^LRRP6A1" D SETACCN Q:LREND
  1. D REPTYP Q:LREND
  1. Q
  1. SITE ;
  1. S LRSITNUM=+$P($G(^XMB(1,1,"XUS")),U,17)
  1. I 'LRSITNUM W !!,"NO SITE DEFINED -- CAN'T REPORT" S LREND=1 Q
  1. S LRSITE=$P($G(^DIC(4,LRSITNUM,0)),U) S:LRSITE="" LRSITE="UNKNOWN"
  1. Q
  1. DIV ;
  1. S %=2 W !,"Do you want to print a specific DIVISION (YES or NO)"
  1. D YN^DICN
  1. I %=-1 S LREND=1 Q
  1. I %=1 D
  1. . S DIC("A")="Select a Division:",DIC=4,DIC(0)="AEMQ"
  1. . F D ^DIC Q:Y=-1 D
  1. . . S LRDIVSEL=+Y
  1. . . S LRDIVSEL(+Y)=$S($L($P($G(^DIC(4,+Y,0)),U)):$P(^(0),U),1:"ERROR"_Y)
  1. I ($D(DTOUT)#2)!(($D(DUOUT)#2)&('$D(LRDIVSEL))) S LREND=1 Q
  1. Q
  1. DATES ;
  1. S %DT="AEX",%DT("A")="BEGIN DATE : "
  1. D ^%DT I (X=U)!(X="") S LREND=1 Q
  1. S LRSDT=Y
  1. S LRSDAT=$$Y2K^LRX(Y)
  1. S %DT="AEX",%DT("A")="END DATE : "
  1. D ^%DT I (X=U)!(X="") S LREND=1 Q
  1. S LREDT=Y
  1. S LREDAT=$$Y2K^LRX(Y)
  1. I LREDT<LRSDT S X=LREDT,LREDT=LRSDT,LRSDT=X
  1. S LRSDT=LRSDT-.000001
  1. S LRDATRNG=LRSDAT_" to "_LREDAT
  1. Q
  1. METHOD ;
  1. K DIR S DIR("A",1)="TEST AUDIT should not be used for workload reporting."
  1. S DIR("A",2)="It should ONLY be used for trouble Shooting.",DIR("A",3)=" "
  1. S DIR(0)="SM^T:TEST AUDIT (File 68);W:WORKLOAD CODE (File 64.1)",DIR("A")="REPORT BY"
  1. D ^DIR I ($D(DUOUT))!($D(DTOUT)) S LREND=1 Q
  1. S ZTRTN=$S(Y="T":"DQ^LRRP6A1",Y="W":"DQ^LRRP6B1")
  1. K DIR
  1. Q
  1. ACCAREA ;
  1. K DIC S DIC=68,DIC(0)="AEMQZ"
  1. S DIC("A")="Select ACCESSION AREA (required - 1 only): "
  1. D ^DIC
  1. I Y=-1 S LREND=1 Q
  1. S LRX=$P(Y,U,2),LRAA=+Y
  1. S ACCTRNS=$P(^LRO(68,LRAA,0),U,3)
  1. Q
  1. SETACCN ;
  1. ;S LRANL=+$P(^LRO(68,LRAA,1,LRDT,1,0),U,4)
  1. K DIR
  1. S DIR(0)="NO^1:999999"
  1. S DIR("A")="Start with accession #",DIR("B")=1
  1. D ^DIR I $D(DUOUT)!($D(DTOUT)) S LREND=1 Q
  1. S:X>0 LRANF=X-1
  1. S:ACCTRNS="Y" LRDT=$E(LRSDT,1,3)_"0000"
  1. S:ACCTRNS'="Y" LRDT=$E(LRSDT,1,3)_"00"
  1. ;S LAST=$P(^LRO(68,LRAA,1,LRDT,1,0),U,4)
  1. K DIR
  1. S DIR(0)="NO^1:999999"
  1. S DIR("A")="End with accession #",DIR("B")=999999
  1. D ^DIR I $D(DUOUT)!($D(DTOUT)) S LREND=1 Q
  1. S LRANL=+X
  1. Q
  1. REPTYP ;
  1. K DIR S DIR(0)="SM^D:DETAILED;C:CONDENSED",DIR("A")="REPORT TYPE"
  1. D ^DIR I $D(DUOUT)!($D(DTOUT)) S LREND=1 Q
  1. S LRREPTYP=Y
  1. K DIR
  1. Q
  1. DEVICE ;
  1. K IOP,IO("Q") S POP=0,%ZIS="QP" D ^%ZIS
  1. I POP S LREND=1 Q
  1. I $D(IO("Q")) D QUE S LREND=1 Q
  1. Q
  1. WRAPUP ;
  1. W:'LREND !!,?23,"*** END OF REPORT ***"
  1. D:($E(IOST,1,2)="C-")&('LREND) PAUSE
  1. W !! W:$E(IOST,1,2)="P-" @IOF D:'$D(ZTQUEUED) ^%ZISC
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. K ^TMP("LR",$J)
  1. K DTOUT,DUOUT,DIRUT,DIROUT,X,Y,%,%ZIS,DIC,%Y,%DT,I,POP,DIR
  1. K ZTIO,ZTRTN,ZTSAVE,ZTDESC,ZTSK,LRAA,LRANN,LRSUM,LRTMULT
  1. K LREND,LRPAG,LRDT,LRDAT,LRSDT,LREDT,LRSDAT,LREDAT,LRDATRNG,LRX,LRNODE
  1. K LRTIC,LRANF,LRANL
  1. K LRDIV,LRDIVNAM,LRDIVSEL,LRFIRST,LRREPTYP,LRTN,LRTST,LRTSTREC,LRTNAM
  1. K LRSITNUM,LRSITE,LRCC,LRAN,LRCPN,LRDASH,LRSTAR,LRSUBH,LRV657,LRV658
  1. D WKLDCLN^LRCAPU
  1. Q
  1. QUE ;
  1. K IO("Q") I '$D(ZTIO),$D(ION),ION="" S ZTIO=""
  1. S ZTDESC="LRRP6_ - TEST/WKLD/VENIPUNCTURE REP"
  1. S ZTSAVE("LR*")="" D ^%ZTLOAD
  1. Q
  1. PAUSE ;
  1. K DIR S DIR(0)="E" D ^DIR
  1. S:($D(DTOUT))!($D(DUOUT)) LREND=1
  1. Q