source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARCU.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1LRARCU ;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
4WKLDNAME(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
24WKLDCODE(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
38WKLDCLN ;Kill WKLD vars
39 ;CALLED BY: LRARCML/LRARCR4/LRARCMA
40 K LRCAPIFN,LRCAPNAM,LRCAPNUM,LRCAPFLG
41 Q
42KILLALL ;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
71DIS ;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
78PRTINIT ;
79 S (LRDSHS,LRSTRS)=""
80 S $P(LRDSHS,"-",IOM)="-"
81 S $P(LRSTRS,"*",IOM)="*"
82 S LRPAG=0
83 Q
84PRTCLN ;
85 K LRHDR,LRHDR2,LRHDR3,LRCLHDR,LRCLHDR2,LRCLHDR3,LRDSHS,LRSTRS,LRPAG
86 Q
87NPG ;New page
88 D:$E(IOST,1,2)="C-" PAUSE
89 Q:LREND
90 W @IOF
91 D HDR
92 Q
93HDR ;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
103PAUSE ;
104 K DIR S DIR(0)="E" D ^DIR
105 S:($D(DTOUT))!($D(DUOUT)) LREND=1
106 Q
Note: See TracBrowser for help on using the repository browser.