LRARCMR.m

LRARCMR ; IHS/DIR/AAB - SETUP ARCHIVED WORKLOAD REPORT PARAMETERS ; [ 5/22/95 ]

 ;;5.2;LR;**1002**;JUN 01, 1998

 ;;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

LRARCMR   ; IHS/DIR/AAB - SETUP ARCHIVED WORKLOAD REPORT PARAMETERS ; [ 5/22/95 ]

 +1       ;;5.2;LR;**1002**;JUN 01, 1998

 +2       ;;5.2;LAB SERVICE;**59**;Aug 31, 1995

 +3       ;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