| 1 | LRARCU ;DALISC/CKA - LAB ARCHIVED CAP UTILITIES ;5/22/95
 | 
|---|
| 2 |  ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
 | 
|---|
| 3 |  ;same as LRCAPU except archived wkld file
 | 
|---|
| 4 | WKLDNAME(LRCC) ;Call with CAP code or IFN, returns WKLD proc name.
 | 
|---|
| 5 |  ;Sets these vars:
 | 
|---|
| 6 |  ;  LRCAPNAM=WKLD proc name
 | 
|---|
| 7 |  ;  LRCAPFLG=Reportable flag
 | 
|---|
| 8 |  ;  LRCAPNUM=the WKLD code #
 | 
|---|
| 9 |  ;  LRCAPIFN=IFN of the WKLD entry
 | 
|---|
| 10 |  ;The caller must kill these when done.
 | 
|---|
| 11 |  ;Called by: LRARCAM5,LRARCMA1,LRARCML1,LRARCMR1,LRARCPTS,LRARCR2
 | 
|---|
| 12 |  ;Called by:
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  N LRNOD,LRNAM
 | 
|---|
| 15 |  S LRNAM="*ERROR* CAN'T FIND WKLD CODE:  "_LRCC
 | 
|---|
| 16 |  S LRCAPFLG=-1,(LRCAPNAM,LRCAPNUM,LRCAPIFN)=""
 | 
|---|
| 17 |  Q:'$L($G(LRCC)) LRNAM
 | 
|---|
| 18 |  I LRCC["." S LRCC=$O(^LAM("C",LRCC_" ",0)) Q:'LRCC LRNAM
 | 
|---|
| 19 |  S LRNOD=$G(^LAM(LRCC,0)) Q:'$L(LRNOD) LRNAM
 | 
|---|
| 20 |  S (LRCAPNAM,LRNAM)=$E($P(LRNOD,U),1,63),LRCAPNUM=$P(LRNOD,U,2)
 | 
|---|
| 21 |  S LRCAPFLG=+$P(LRNOD,U,5),LRCAPIFN=LRCC
 | 
|---|
| 22 |  S:LRCAPFLG (LRCAPNAM,LRNAM)="+"_LRCAPNAM
 | 
|---|
| 23 |  Q LRNAM
 | 
|---|
| 24 | WKLDCODE(LRCC) ;Call with WKLD proc name, returns WKLD code #.
 | 
|---|
| 25 |  ;Sets these vars:
 | 
|---|
| 26 |  ;  LRCAPNUM=the WKLD code #
 | 
|---|
| 27 |  ;  LRCAPIFN=the IFN of the WKLD entry
 | 
|---|
| 28 |  ;Called by: LRARCMA1,LRARCML1,LRARCPTS
 | 
|---|
| 29 |  ;Called by:
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  N LRNOD
 | 
|---|
| 32 |  S (LRCAPNUM,LRCAPIFN)=""
 | 
|---|
| 33 |  Q:'$L($G(LRCC)) LRCAPNUM
 | 
|---|
| 34 |  S LRCAPIFN=$O(^LAM("B",LRCC,0)) Q:'LRCAPIFN LRCAPNUM
 | 
|---|
| 35 |  S LRNOD=$G(^LAM(LRCAPIFN,0)) Q:'$L(LRNOD) LRCAPNUM
 | 
|---|
| 36 |  S LRCAPNUM=$P(LRNOD,U,2)
 | 
|---|
| 37 |  Q LRCAPNUM
 | 
|---|
| 38 | WKLDCLN ;Kill WKLD vars
 | 
|---|
| 39 |  ;CALLED BY: LRARCML/LRARCR4/LRARCMA
 | 
|---|
| 40 |  K LRCAPIFN,LRCAPNAM,LRCAPNUM,LRCAPFLG
 | 
|---|
| 41 |  Q
 | 
|---|
| 42 | KILLALL ;Kill all variables used by archived wkld report routines
 | 
|---|
| 43 |  K %,%DT,%ZIS,A,D0,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,DX,DY,I,IX
 | 
|---|
| 44 |  K J,K,LR,LRAA,LRAACK,LRAANO,LRAAX,LRACCREC,LRACNT,LRAD,LRAGT,LRAN
 | 
|---|
| 45 |  K LRANS,LRAPICGT,LRAPIGT,LRAPIGTU,LRAPIIGT,LRAPINGT,LRAPIOGT,LRAPSUB
 | 
|---|
| 46 |  K LRARY,LRAST,LRBLDONE,LRBS,LRCAP,LRCAPAM5,LRCAPFLG,LRCAPIFN,LRCAPN
 | 
|---|
| 47 |  K LRCAPNAM,LRCAPNUM,LRCAPS,LRCAPSUB,LRCAPT,LRCAPTOT,LRCC,LRCCN,LRCCNT
 | 
|---|
| 48 |  K LRCCNX,LRCCX,LRCCZ,LRCDR,LRCDT,LRCDTB,LRCDTE,LRCDTN,LRCGT,LRCLHDR,LRCLHDR2,LRCLHDR3
 | 
|---|
| 49 |  K LRCM,LRCNT,LRCNTL,LRCODE,LRCODSTR,LRCOL,LRCOM,LRCOMM,LRCONT,LRCP
 | 
|---|
| 50 |  K LRCPICGT,LRCPIGT,LRCPIGTU,LRCPIIGT,LRCPINGT,LRCPIOGT,LRCPN,LRCPSUB,LRCPSX
 | 
|---|
| 51 |  K LRCPT,LRCST,LRCTL,LRCTM,LRCTMB,LRCTME,LRCTMN,LRCTSX,LRCW,LRDA,LRDAT
 | 
|---|
| 52 |  K LRDATD,LRDATE,LRDATX,LRDCN,LRDOT,LRDSH,LRDSHS,LRDT,LRDT1,LRDT2,LRDTH,LRDTYP
 | 
|---|
| 53 |  K LRDUMMY,LREDT,LREND,LRERR,LRFIL,LRFILE,LRFIRST,LRFL,LRFLG,LRFR,LRFRD,LRFRV
 | 
|---|
| 54 |  K LRGCN,LRGETIN,LRGMANL,LRGQC,LRGRPT,LRGSTND,LRGT,LRGTOT,LRGTOTS,LRGTREC,LRGTU
 | 
|---|
| 55 |  K LRHD0,LRHDR,LRHDR2,LRHDR3,LRDHRFIT,LRHDRLEN,LRIAGT,LRICGT,LRICNT,LRICS
 | 
|---|
| 56 |  K LRIFN,LRIGT,LRIGTU,LRIIGT,LRIN,LRINGT,LRINN,LRINST,LRIOGT,LRIOPAT,LRIPOT
 | 
|---|
| 57 |  K LRIST,LRLAB,LRLARE,LRLC,LRLDIV,LRLINE,LRLMAC,LRLOC,LRLOOP,LRLSS,LRLSSA
 | 
|---|
| 58 |  K LRLSSN,LRLTYP,LRMA,LRMAA,LRMAC,LRMACN,LRMAN,LRMANL,LRMCT,LRMII,LRMIO,LRMIPER
 | 
|---|
| 59 |  K LRMNODE,LRMT,LRMTP,LRN,LRN1,LRN2,LRNAM,LRNCNT,LRNDFN,LRNGT,LRNOD,LRNODE
 | 
|---|
| 60 |  K LRNPOT,LRNST,LRNT,LRNX,LRNX5,LRNX5D,LROCNT,LROGT,LROPOT,LROSOT,LROST
 | 
|---|
| 61 |  K LROTHER,LRPAG,LRPAGE,LRPATOK,LRPG,LRPRD,LRPTF,LRPTR,LRPTYP,LRQC,LRRCNT
 | 
|---|
| 62 |  K LRREC,LRREC2,LRREC3,LRREP,LRRPT,LRRPTM,LRRTYP,LRSB,LRSDT,LRSITE,LRSITNUM,LRSITSEL,LRSKIP,LRSOOT
 | 
|---|
| 63 |  K LRSOT,LRSOT1,LRSP,LRSPEC,LRSQRM,LRST,LRSTAT,LRSTCS,LRSTD,LRSTND,LRSTR
 | 
|---|
| 64 |  K LRSTRS,LRSTU,LRSTY,LRSUBF,LRSUBH,LRSUBH1,LRSUM,LRSUMM,LRSV,LRTC,LRTEST
 | 
|---|
| 65 |  K LRTESTCP,LRTITLE,LRTMTOT,LRTO,LRTOD,LRTOST,LRTOT,LRTOT1,LRTOV,LRTRE
 | 
|---|
| 66 |  K LRTRE1,LRTRE1T,LRTREAT,LRTREATN,LRTRET,LRTRN,LRTS,LRTSN,LRTST,LRTSTOT
 | 
|---|
| 67 |  K LRTSTS,LRTYCSP,LRTYP,LRUC,LRURG,LRURGCNT,LRURGNAM,LRUW,LRUWSP
 | 
|---|
| 68 |  K LRVD,LRVERD,LRWC,LRX,LRX1,LRX2,LRX4,LRXX1,LRXX2,LRZTSK,N,N0,NODE,POP,X,Y,Y1,Y2
 | 
|---|
| 69 |  K ZTDESC,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
 | 
|---|
| 70 |  Q
 | 
|---|
| 71 | DIS ;Display Accession workload  called by LRCAPVM
 | 
|---|
| 72 |  N DA,DIC,D0,DIE,DX,DR,IX,LRICS,X,LREND
 | 
|---|
| 73 |  S DR=0,DA(1)=0,DA(2)=LRAN,DA(3)=LRAD,DA(4)=LRAA,LRICS="^LRO(68,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",4," W @IOF
 | 
|---|
| 74 |  S IX=0 F  S IX=$O(LRTS(IX)) Q:IX<1!($G(LREND))  D
 | 
|---|
| 75 |  . S DA(1)=IX,DIC=LRICS_DA(1)_",1," S X=$G(^LAB(60,DA(1),0)) I $L(X) W !,$P(X,U),! S DA=0 D
 | 
|---|
| 76 |  . .F  S DA=$O(@(DIC_DA_")")) Q:DA<1!($G(LREND))  D EN^DIQ I $E(IOST,1,2)="C-"&($Y>16) D PAUSE W:'$G(LREND) @IOF
 | 
|---|
| 77 |  Q
 | 
|---|
| 78 | PRTINIT ;
 | 
|---|
| 79 |  S (LRDSHS,LRSTRS)=""
 | 
|---|
| 80 |  S $P(LRDSHS,"-",IOM)="-"
 | 
|---|
| 81 |  S $P(LRSTRS,"*",IOM)="*"
 | 
|---|
| 82 |  S LRPAG=0
 | 
|---|
| 83 |  Q
 | 
|---|
| 84 | PRTCLN ;
 | 
|---|
| 85 |  K LRHDR,LRHDR2,LRHDR3,LRCLHDR,LRCLHDR2,LRCLHDR3,LRDSHS,LRSTRS,LRPAG
 | 
|---|
| 86 |  Q
 | 
|---|
| 87 | NPG ;New page
 | 
|---|
| 88 |  D:$E(IOST,1,2)="C-" PAUSE
 | 
|---|
| 89 |  Q:LREND
 | 
|---|
| 90 |  W @IOF
 | 
|---|
| 91 |  D HDR
 | 
|---|
| 92 |  Q
 | 
|---|
| 93 | HDR ;Header for 80 col.
 | 
|---|
| 94 |  S LRPAG=LRPAG+1
 | 
|---|
| 95 |  W:$D(LRHDR)#2 !?((80-$L(LRHDR))/2),LRHDR,?72,"Page ",$J(LRPAG,3),!
 | 
|---|
| 96 |  W:$D(LRHDR2)#2 ?((80-$L(LRHDR2))/2),LRHDR2,!
 | 
|---|
| 97 |  W:$D(LRHDR3)#2 ?((80-$L(LRHDR3))/2),LRHDR3,!
 | 
|---|
| 98 |  W:$D(LRCLHDR)#2 !,LRCLHDR,!
 | 
|---|
| 99 |  W:$D(LRCLHDR2)#2 LRCLHDR2,!
 | 
|---|
| 100 |  W:$D(LRCLHDR3)#2 LRCLHDR3,!
 | 
|---|
| 101 |  W $E(LRDSHS,1,80),!
 | 
|---|
| 102 |  Q
 | 
|---|
| 103 | PAUSE ;
 | 
|---|
| 104 |  K DIR S DIR(0)="E" D ^DIR
 | 
|---|
| 105 |  S:($D(DTOUT))!($D(DUOUT)) LREND=1
 | 
|---|
| 106 |  Q
 | 
|---|