- 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 ---[H[J[2J[HLRARCML 1068 printed Feb 18, 2025@23:35:02 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