- LRARCMA ; IHS/DIR/AAB - ARCHIVED WKLD REPORT BY MAJOR SECTION ; [ 6/1/95 ]
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
- ;same as LRCAPMA except archived wkld file
- EN ;
- ; GET THE PARAMETERS
- S (LRSUMM,LREND)=0,LRNDFN="UNDEFINED"
- ;Check for lab archival activity in archived status
- S LRART=64.1,LRARC=0 S LRARC=$O(^LAB(95.11,"O",2,LRART,LRARC))
- I LRARC="" D ERROR
- D ASKCOM^LRARCMR2
- D ^LRARCMR
- I 'LREND D
- . I IO'=IO(0) D LOAD
- . E D DQ
- D CLEAN
- Q
- DQ ;
- K ^TMP("LRAR-WL",$J)
- S (LREND,LRLOOP,LRBLDONE)=0
- S (LRCGT,LRIGT,LROGT,LRNGT)=0
- I $D(ZTQUEUED) S ZTREQ="@"
- I 'LRIN S LRLOOP=1
- D EN^LRARCMA1
- D EN^LRARCMA2
- D:$D(ZTQUEUED) CLEAN
- Q
- LOAD ;
- S ZTDESC="WKLD STATS BY MAJ SEC REP"
- S ZTRTN="DQ^LRARCMA",ZTSAVE("LR*")=""
- D ^%ZTLOAD
- Q
- CLEAN ;
- D ^%ZISC,PRTCLN^LRARCU,WKLDCLN^LRARCU,CLNMAN^LRARCMR1
- K ^TMP("LRAR-WL",$J)
- D KILLALL^LRARCU
- Q
- ERROR W !!,$C(7),"This file does not have an archival activity with the status of archived."
- W !,"Therefore this file may be incomplete if archiving is still in progress."
- W !!
- Q
- LRARCMA ; IHS/DIR/AAB - ARCHIVED WKLD REPORT BY MAJOR SECTION ; [ 6/1/95 ]
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
- +3 ;same as LRCAPMA except archived wkld file
- EN ;
- +1 ; GET THE PARAMETERS
- +2 SET (LRSUMM,LREND)=0
- SET LRNDFN="UNDEFINED"
- +3 ;Check for lab archival activity in archived status
- +4 SET LRART=64.1
- SET LRARC=0
- SET LRARC=$ORDER(^LAB(95.11,"O",2,LRART,LRARC))
- +5 IF LRARC=""
- DO ERROR
- +6 DO ASKCOM^LRARCMR2
- +7 DO ^LRARCMR
- +8 IF 'LREND
- Begin DoDot:1
- +9 IF IO'=IO(0)
- DO LOAD
- +10 IF '$TEST
- DO DQ
- End DoDot:1
- +11 DO CLEAN
- +12 QUIT
- DQ ;
- +1 KILL ^TMP("LRAR-WL",$JOB)
- +2 SET (LREND,LRLOOP,LRBLDONE)=0
- +3 SET (LRCGT,LRIGT,LROGT,LRNGT)=0
- +4 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +5 IF 'LRIN
- SET LRLOOP=1
- +6 DO EN^LRARCMA1
- +7 DO EN^LRARCMA2
- +8 IF $DATA(ZTQUEUED)
- DO CLEAN
- +9 QUIT
- LOAD ;
- +1 SET ZTDESC="WKLD STATS BY MAJ SEC REP"
- +2 SET ZTRTN="DQ^LRARCMA"
- SET ZTSAVE("LR*")=""
- +3 DO ^%ZTLOAD
- +4 QUIT
- CLEAN ;
- +1 DO ^%ZISC
- DO PRTCLN^LRARCU
- DO WKLDCLN^LRARCU
- DO CLNMAN^LRARCMR1
- +2 KILL ^TMP("LRAR-WL",$JOB)
- +3 DO KILLALL^LRARCU
- +4 QUIT
- ERROR WRITE !!,$CHAR(7),"This file does not have an archival activity with the status of archived."
- +1 WRITE !,"Therefore this file may be incomplete if archiving is still in progress."
- +2 WRITE !!
- +3 QUIT
