LRARCMR ;DALISC/CKA - SETUP ARCHIVED WORKLOAD REPORT PARAMETERS;5/22/95
;;5.2;LAB SERVICE;**59**;Aug 31, 1995
;same as LRCAPMR except archived wkld file
EN ;called by LRARCML,LRARCTS,LRARCMA
PARMS ; SET PARAMATERS
D GETINST
D:'LREND BDT
D:'LREND EDT
D:'LREND GETAA
D:'LREND SUMQ
D:'LREND DEVICE
Q
GETINST R !,"SELECT ALL INSTITUTIONS? YES// ",LRIN:DTIME
I '$T!(LRIN["^") S LREND=1 Q
I LRIN["?" W !,"ENTER YES OR NO, Y OR N" G GETINST
I LRIN=""!(LRIN="Y")!(LRIN="YES") S LRIN=0,LRINN="" Q
S LRIN=$S(+DUZ(2):+DUZ(2),+$P($G(^XMB(1,1,"XUS")),U,17):+$P(^("XUS"),U,17),1:0)
D INS
Q
INS ;
K DIC S DIC="^LAR(64.19999,",DIC(0)="AEQM" S:LRIN DIC("B")=$P($G(^DIC(4,LRIN,0)),U)
D ^DIC I Y<0 S LREND=1 Q
S LRIN=+Y,LRINN=$P(Y,"^",2)
Q
BDT ;
K %DT,DTOUT,DUOUT
S %DT="AESX",%DT("A")="BEGINNING DATE/TIME: ",%DT("B")="T-31"
D ^%DT I Y=-1 S LREND=1 Q
S LRCDTB=$P(Y,".")
S LRCTMB=($S(+$P(Y,".",2):"."_$P(Y,".",2),1:0.0001)-.00001)
S Y1=Y,Y2=1,LRDT1=$$DDDATE^LRAFUNC1(Y1,Y2)
Q
EDT ;
K %DT,DTOUT,DUOUT
S %DT="AESX",%DT("A")="ENDING DATE/TIME: ",%DT("B")="T"
D ^%DT I Y=-1 S LREND=1 Q
S LRCDTE=$P(Y,"."),LRCTME=$S(+$P(Y,".",2):"."_$P(Y,".",2)*10000,1:2400)
S Y1=Y,LRDT2=$$DDDATE^LRAFUNC1(Y1,Y2) K Y1,Y2
Q
GETAA S LRAA=0 W !
K DIR,X,Y S DIR(0)="S^Y:YES;N:NO",DIR("B")="NO"
S DIR("A")="Do you want to select accession areas (YES or NO) "
S DIR("?")="Enter 'YES' to limit report to one or more accession areas."
D ^DIR
Q:Y="N"
I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
K DIC S DIC=68,DIC(0)="AEMQZ"
F D ^DIC Q:Y=-1 D
.S LRAA=+Y,LRAA(+Y)=$P(Y(0),U,11),LRAAX(Y(0,0))=Y(0,0)
I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
Q
DEVICE ;
K %ZIS,POP S %ZIS="QN" D ^%ZIS
I POP S LREND=1
Q
SUMQ ;
R !!,"SUMMARY REPORT ONLY? NO//",LRSUMM:DTIME
I '$T!(LRSUMM="^") S LREND=1 Q
I LRSUMM["?" W !,"Do you want only the summary? YES or NO.",! G SUMQ
S LRSUMM=$S($E(LRSUMM,1)="Y"!(LRSUMM="YES")!($E(LRSUMM,1)="y")!(LRSUMM="yes"):1,1:0) W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCMR 2006 printed Nov 22, 2024@17:19:18 Page 2
LRARCMR ;DALISC/CKA - SETUP ARCHIVED WORKLOAD REPORT PARAMETERS;5/22/95
+1 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
+2 ;same as LRCAPMR except archived wkld file
EN ;called by LRARCML,LRARCTS,LRARCMA
PARMS ; SET PARAMATERS
+1 DO GETINST
+2 if 'LREND
DO BDT
+3 if 'LREND
DO EDT
+4 if 'LREND
DO GETAA
+5 if 'LREND
DO SUMQ
+6 if 'LREND
DO DEVICE
+7 QUIT
GETINST READ !,"SELECT ALL INSTITUTIONS? YES// ",LRIN:DTIME
+1 IF '$TEST!(LRIN["^")
SET LREND=1
QUIT
+2 IF LRIN["?"
WRITE !,"ENTER YES OR NO, Y OR N"
GOTO GETINST
+3 IF LRIN=""!(LRIN="Y")!(LRIN="YES")
SET LRIN=0
SET LRINN=""
QUIT
+4 SET LRIN=$SELECT(+DUZ(2):+DUZ(2),+$PIECE($GET(^XMB(1,1,"XUS")),U,17):+$PIECE(^("XUS"),U,17),1:0)
+5 DO INS
+6 QUIT
INS ;
+1 KILL DIC
SET DIC="^LAR(64.19999,"
SET DIC(0)="AEQM"
if LRIN
SET DIC("B")=$PIECE($GET(^DIC(4,LRIN,0)),U)
+2 DO ^DIC
IF Y<0
SET LREND=1
QUIT
+3 SET LRIN=+Y
SET LRINN=$PIECE(Y,"^",2)
+4 QUIT
BDT ;
+1 KILL %DT,DTOUT,DUOUT
+2 SET %DT="AESX"
SET %DT("A")="BEGINNING DATE/TIME: "
SET %DT("B")="T-31"
+3 DO ^%DT
IF Y=-1
SET LREND=1
QUIT
+4 SET LRCDTB=$PIECE(Y,".")
+5 SET LRCTMB=($SELECT(+$PIECE(Y,".",2):"."_$PIECE(Y,".",2),1:0.0001)-.00001)
+6 SET Y1=Y
SET Y2=1
SET LRDT1=$$DDDATE^LRAFUNC1(Y1,Y2)
+7 QUIT
EDT ;
+1 KILL %DT,DTOUT,DUOUT
+2 SET %DT="AESX"
SET %DT("A")="ENDING DATE/TIME: "
SET %DT("B")="T"
+3 DO ^%DT
IF Y=-1
SET LREND=1
QUIT
+4 SET LRCDTE=$PIECE(Y,".")
SET LRCTME=$SELECT(+$PIECE(Y,".",2):"."_$PIECE(Y,".",2)*10000,1:2400)
+5 SET Y1=Y
SET LRDT2=$$DDDATE^LRAFUNC1(Y1,Y2)
KILL Y1,Y2
+6 QUIT
GETAA SET LRAA=0
WRITE !
+1 KILL DIR,X,Y
SET DIR(0)="S^Y:YES;N:NO"
SET DIR("B")="NO"
+2 SET DIR("A")="Do you want to select accession areas (YES or NO) "
+3 SET DIR("?")="Enter 'YES' to limit report to one or more accession areas."
+4 DO ^DIR
+5 if Y="N"
QUIT
+6 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+7 KILL DIC
SET DIC=68
SET DIC(0)="AEMQZ"
+8 FOR
DO ^DIC
if Y=-1
QUIT
Begin DoDot:1
+9 SET LRAA=+Y
SET LRAA(+Y)=$PIECE(Y(0),U,11)
SET LRAAX(Y(0,0))=Y(0,0)
End DoDot:1
+10 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+11 QUIT
DEVICE ;
+1 KILL %ZIS,POP
SET %ZIS="QN"
DO ^%ZIS
+2 IF POP
SET LREND=1
+3 QUIT
SUMQ ;
+1 READ !!,"SUMMARY REPORT ONLY? NO//",LRSUMM:DTIME
+2 IF '$TEST!(LRSUMM="^")
SET LREND=1
QUIT
+3 IF LRSUMM["?"
WRITE !,"Do you want only the summary? YES or NO.",!
GOTO SUMQ
+4 SET LRSUMM=$SELECT($EXTRACT(LRSUMM,1)="Y"!(LRSUMM="YES")!($EXTRACT(LRSUMM,1)="y")!(LRSUMM="yes"):1,1:0)
WRITE !
+5 QUIT
