- LRCAPML ;SLC/AM/DALISC/FHS/J0 - WKLD COST REPORT BY MAJ SCTN; 2/6/91@16:04
- ;;5.2;LAB SERVICE;**59,322**;Sep 27, 1994
- EN ;
- ; GET THE PARAMETERS
- S (LRSUMM,LREND)=0,LRNDFN="UNDEFINED"
- D ASKCOM^LRCAPMR2
- D ^LRCAPMR
- I 'LREND D
- . I IO'=IO(0) D LOAD Q
- . D DQ
- D CLEAN
- Q
- DQ ;
- K ^TMP("LR-WL",$J)
- S (LREND,LRLOOP,LRBLDONE)=0
- S:$D(ZTQUEUED) ZTREQ="@" K ZTSK
- I 'LRIN S LRLOOP=1
- D EN^LRCAPML1
- D EN^LRCAPML2
- D:$D(ZTQUEUED) CLEAN
- Q
- LOAD ;
- S ZTDESC="WKLD STATS BY MAJ SEC REP"
- S ZTRTN="DQ^LRCAPML",ZTSAVE("LR*")=""
- D ^%ZTLOAD
- Q
- CLEAN ;
- W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC,PRTCLN^LRCAPU,WKLDCLN^LRCAPU,CLNMAN^LRCAPMR1
- K ^TMP("LR-WL",$J)
- K LRANS,LRCC,LRCDT,LRCTM,LRCW,LRUW,LRWC,LRIGT,LRIGTU,LRQC,LRRPT,LRST
- K LRTC,LRMA,LRMAN,LRLSS,LRLSSN,LRUC,LRX,LRTSN,LRPAG,LRBLDONE,LRGETIN
- K LRGT,LRSTD,LRX1,LRX2,LRAGT,LRGTOTS,LRSUMM,LRNDFN,LRAA,LRTYP,LRZTSK
- K LREND,LRIN,LRINN,LRCDTB,LRCTMB,LRDT1,LRCDTE,LRCTME,LRDT2,LRLOOP,LRLAB
- K LRGTREC,LRREC,LRMAA,LRLSSA,LRLDIV,LRAPIGT,LRAPIGTU,LRCPIGT,LRCPIGTU
- K LRFIRST,LRGTU,LRCOM,LRCOMM,LRMNODE,LRSQRM,LRSTU,LRCM
- K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTQUEUED,%IO,%ZIS
- K DTOUT,DUOUT,DIRUT,DIC,DIR,%DT,Y1,Y2,DX,DY,X,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPML 1198 printed Feb 18, 2025@23:38:55 Page 2
- LRCAPML ;SLC/AM/DALISC/FHS/J0 - WKLD COST REPORT BY MAJ SCTN; 2/6/91@16:04
- +1 ;;5.2;LAB SERVICE;**59,322**;Sep 27, 1994
- EN ;
- +1 ; GET THE PARAMETERS
- +2 SET (LRSUMM,LREND)=0
- SET LRNDFN="UNDEFINED"
- +3 DO ASKCOM^LRCAPMR2
- +4 DO ^LRCAPMR
- +5 IF 'LREND
- Begin DoDot:1
- +6 IF IO'=IO(0)
- DO LOAD
- QUIT
- +7 DO DQ
- End DoDot:1
- +8 DO CLEAN
- +9 QUIT
- DQ ;
- +1 KILL ^TMP("LR-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^LRCAPML1
- +6 DO EN^LRCAPML2
- +7 if $DATA(ZTQUEUED)
- DO CLEAN
- +8 QUIT
- LOAD ;
- +1 SET ZTDESC="WKLD STATS BY MAJ SEC REP"
- +2 SET ZTRTN="DQ^LRCAPML"
- SET ZTSAVE("LR*")=""
- +3 DO ^%ZTLOAD
- +4 QUIT
- CLEAN ;
- +1 WRITE !!
- if $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- DO ^%ZISC
- DO PRTCLN^LRCAPU
- DO WKLDCLN^LRCAPU
- DO CLNMAN^LRCAPMR1
- +2 KILL ^TMP("LR-WL",$JOB)
- +3 KILL LRANS,LRCC,LRCDT,LRCTM,LRCW,LRUW,LRWC,LRIGT,LRIGTU,LRQC,LRRPT,LRST
- +4 KILL LRTC,LRMA,LRMAN,LRLSS,LRLSSN,LRUC,LRX,LRTSN,LRPAG,LRBLDONE,LRGETIN
- +5 KILL LRGT,LRSTD,LRX1,LRX2,LRAGT,LRGTOTS,LRSUMM,LRNDFN,LRAA,LRTYP,LRZTSK
- +6 KILL LREND,LRIN,LRINN,LRCDTB,LRCTMB,LRDT1,LRCDTE,LRCTME,LRDT2,LRLOOP,LRLAB
- +7 KILL LRGTREC,LRREC,LRMAA,LRLSSA,LRLDIV,LRAPIGT,LRAPIGTU,LRCPIGT,LRCPIGTU
- +8 KILL LRFIRST,LRGTU,LRCOM,LRCOMM,LRMNODE,LRSQRM,LRSTU,LRCM
- +9 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTQUEUED,%IO,%ZIS
- +10 KILL DTOUT,DUOUT,DIRUT,DIC,DIR,%DT,Y1,Y2,DX,DY,X,Y
- +11 QUIT