LRARCML.m

LRARCML ;DALISC/CKA  -  ARCHIVED WKLD COST REPORT BY MAJ SCTN; 5/22/95

 ;;5.2;LAB SERVICE;**59,322**;Aug 31, 1995

 ;same as LRCAPML 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 Q

 . D DQ

 D CLEAN

 Q

DQ ;

 K ^TMP("LRAR-WL",$J)

 S (LREND,LRLOOP,LRBLDONE)=0

 S:$D(ZTQUEUED) ZTREQ="@" K ZTSK

 I 'LRIN S LRLOOP=1

 D EN^LRARCML1

 D EN^LRARCML2

 D:$D(ZTQUEUED) CLEAN

 Q

LOAD ;

 S ZTDESC="WKLD STATS BY MAJ SEC REP"

 S ZTRTN="DQ^LRARCML",ZTSAVE("LR*")=""

 D ^%ZTLOAD

 Q

CLEAN ;

 W !! W:$E(IOST,1,2)="P-" @IOF 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRARCML   1068     printed  Apr 09, 2024@21:21:24                                                                                                                                                                                                     Page 2

LRARCML   ;DALISC/CKA  -  ARCHIVED WKLD COST REPORT BY MAJ SCTN; 5/22/95

 +1       ;;5.2;LAB SERVICE;**59,322**;Aug 31, 1995

 +2       ;same as LRCAPML 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

                       QUIT 

 +10               DO DQ

               End DoDot:1

 +11       DO CLEAN

 +12       QUIT 

DQ        ;

 +1        KILL ^TMP("LRAR-WL",$JOB)

 +2        SET (LREND,LRLOOP,LRBLDONE)=0

 +3        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           KILL ZTSK

 +4        IF 'LRIN

               SET LRLOOP=1

 +5        DO EN^LRARCML1

 +6        DO EN^LRARCML2

 +7        if $DATA(ZTQUEUED)

               DO CLEAN

 +8        QUIT 

LOAD      ;

 +1        SET ZTDESC="WKLD STATS BY MAJ SEC REP"

 +2        SET ZTRTN="DQ^LRARCML"

           SET ZTSAVE("LR*")=""

 +3        DO ^%ZTLOAD

 +4        QUIT 

CLEAN     ;

 +1        WRITE !!

           if $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

           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