| [613] | 1 | LRCAPU ;DALISC/J0 - LAB CAP UTILITIES ;3/17/93
|
|---|
| 2 | ;;5.2;LAB SERVICE;**101,105**;Sep 27, 1994
|
|---|
| 3 | WKLDNAME(LRCC) ;Call with CAP code or IFN, returns WKLD proc name.
|
|---|
| 4 | ;Sets these vars:
|
|---|
| 5 | ; LRCAPNAM=WKLD proc name
|
|---|
| 6 | ; LRCAPFLG=Reportable flag
|
|---|
| 7 | ; LRCAPNUM=the WKLD code #
|
|---|
| 8 | ; LRCAPIFN=IFN of the WKLD entry
|
|---|
| 9 | ;The caller must kill these when done.
|
|---|
| 10 | ;Called by: LRCAPML/LRCAPR2/LRRP6A1/LRRP6B1,LRRP8C,LRCAPMA
|
|---|
| 11 | ;Called by:
|
|---|
| 12 | ;
|
|---|
| 13 | N LRNOD,LRNAM
|
|---|
| 14 | S LRNAM="*ERROR* CAN'T FIND WKLD CODE: "_LRCC
|
|---|
| 15 | S LRCAPFLG=-1,(LRCAPNAM,LRCAPNUM,LRCAPIFN)=""
|
|---|
| 16 | Q:'$L($G(LRCC)) LRNAM
|
|---|
| 17 | I LRCC?5N1"."4N.5N S LRCC=$O(^LAM("C",LRCC_" ",0)) Q:'LRCC LRNAM
|
|---|
| 18 | S LRNOD=$G(^LAM(LRCC,0)) Q:'$L(LRNOD) LRNAM
|
|---|
| 19 | S (LRCAPNAM,LRNAM)=$E($P(LRNOD,U),1,63),LRCAPNUM=$P(LRNOD,U,2)
|
|---|
| 20 | S LRCAPFLG=+$P(LRNOD,U,5),LRCAPIFN=LRCC
|
|---|
| 21 | S:LRCAPFLG (LRCAPNAM,LRNAM)="+"_LRCAPNAM
|
|---|
| 22 | Q LRNAM
|
|---|
| 23 | WKLDCLN ;Kill WKLD vars
|
|---|
| 24 | ;CALLED BY: LRCAPML/LRCAPR4/LRRP6,LRCAPMA,LRRP8
|
|---|
| 25 | K LRCAPIFN,LRCAPNAM,LRCAPNUM,LRCAPFLG
|
|---|
| 26 | Q
|
|---|
| 27 | DIS ;Display Accession workload called by LRCAPVM
|
|---|
| 28 | N DA,DIC,D0,DIE,DX,DR,IX,LRICS,X,LREND
|
|---|
| 29 | 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
|
|---|
| 30 | S IX=0 F S IX=$O(LRTS(IX)) Q:IX<1!($G(LREND)) D
|
|---|
| 31 | . 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
|
|---|
| 32 | . .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
|
|---|
| 33 | Q
|
|---|
| 34 | PRTINIT ;
|
|---|
| 35 | S (LRDSHS,LRSTRS)=""
|
|---|
| 36 | S $P(LRDSHS,"-",IOM)="-"
|
|---|
| 37 | S $P(LRSTRS,"*",IOM)="*"
|
|---|
| 38 | S LRPAG=0
|
|---|
| 39 | Q
|
|---|
| 40 | PRTCLN ;
|
|---|
| 41 | K LRHDR,LRHDR2,LRHDR3,LRCLHDR,LRCLHDR2,LRCLHDR3,LRDSHS,LRSTRS,LRPAG
|
|---|
| 42 | Q
|
|---|
| 43 | NPG ;New page
|
|---|
| 44 | D:$E(IOST,1,2)="C-" PAUSE
|
|---|
| 45 | Q:LREND
|
|---|
| 46 | W @IOF
|
|---|
| 47 | D HDR
|
|---|
| 48 | Q
|
|---|
| 49 | HDR ;Header for 80 col.
|
|---|
| 50 | S LRPAG=LRPAG+1
|
|---|
| 51 | W:$D(LRHDR)#2 !?((80-$L(LRHDR))/2),LRHDR,?72,"Page ",$J(LRPAG,3),!
|
|---|
| 52 | W:$D(LRHDR2)#2 ?((80-$L(LRHDR2))/2),LRHDR2,!
|
|---|
| 53 | W:$D(LRHDR3)#2 ?((80-$L(LRHDR3))/2),LRHDR3,!
|
|---|
| 54 | W:$D(LRCLHDR)#2 !,LRCLHDR,!
|
|---|
| 55 | W:$D(LRCLHDR2)#2 LRCLHDR2,!
|
|---|
| 56 | W:$D(LRCLHDR3)#2 LRCLHDR3,!
|
|---|
| 57 | W $E(LRDSHS,1,80),!
|
|---|
| 58 | Q
|
|---|
| 59 | PAUSE ;
|
|---|
| 60 | Q:$G(LREND)
|
|---|
| 61 | K DIR S DIR(0)="E" D ^DIR
|
|---|
| 62 | S:($D(DTOUT))!($D(DUOUT)) LREND=1
|
|---|
| 63 | Q
|
|---|
