Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRCAPU

LRCAPU.m

Go to the documentation of this file.
  1. LRCAPU ; IHS/DIR/FJE - LAB CAP UTILITIES ; [ 3/17/93 ]
  1. ;;5.2;LR;;NOV 01, 1997
  1. ;
  1. ;;5.2;LAB SERVICE;**101,105**;Sep 27, 1994
  1. WKLDNAME(LRCC) ;Call with CAP code or IFN, returns WKLD proc name.
  1. ;Sets these vars:
  1. ; LRCAPNAM=WKLD proc name
  1. ; LRCAPFLG=Reportable flag
  1. ; LRCAPNUM=the WKLD code #
  1. ; LRCAPIFN=IFN of the WKLD entry
  1. ;The caller must kill these when done.
  1. ;Called by: LRCAPML/LRCAPR2/LRRP6A1/LRRP6B1,LRRP8C,LRCAPMA
  1. ;Called by:
  1. ;
  1. N LRNOD,LRNAM
  1. S LRNAM="*ERROR* CAN'T FIND WKLD CODE: "_LRCC
  1. S LRCAPFLG=-1,(LRCAPNAM,LRCAPNUM,LRCAPIFN)=""
  1. Q:'$L($G(LRCC)) LRNAM
  1. I LRCC?5N1"."4N.5N S LRCC=$O(^LAM("C",LRCC_" ",0)) Q:'LRCC LRNAM
  1. S LRNOD=$G(^LAM(LRCC,0)) Q:'$L(LRNOD) LRNAM
  1. S (LRCAPNAM,LRNAM)=$E($P(LRNOD,U),1,63),LRCAPNUM=$P(LRNOD,U,2)
  1. S LRCAPFLG=+$P(LRNOD,U,5),LRCAPIFN=LRCC
  1. S:LRCAPFLG (LRCAPNAM,LRNAM)="+"_LRCAPNAM
  1. Q LRNAM
  1. WKLDCLN ;Kill WKLD vars
  1. ;CALLED BY: LRCAPML/LRCAPR4/LRRP6,LRCAPMA,LRRP8
  1. K LRCAPIFN,LRCAPNAM,LRCAPNUM,LRCAPFLG
  1. Q
  1. DIS ;Display Accession workload called by LRCAPVM
  1. N DA,DIC,D0,DIE,DX,DR,IX,LRICS,X,LREND
  1. 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
  1. S IX=0 F S IX=$O(LRTS(IX)) Q:IX<1!($G(LREND)) D
  1. . 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
  1. . .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
  1. Q
  1. PRTINIT ;
  1. S (LRDSHS,LRSTRS)=""
  1. S $P(LRDSHS,"-",IOM)="-"
  1. S $P(LRSTRS,"*",IOM)="*"
  1. S LRPAG=0
  1. Q
  1. PRTCLN ;
  1. K LRHDR,LRHDR2,LRHDR3,LRCLHDR,LRCLHDR2,LRCLHDR3,LRDSHS,LRSTRS,LRPAG
  1. Q
  1. NPG ;New page
  1. D:$E(IOST,1,2)="C-" PAUSE
  1. Q:LREND
  1. W @IOF
  1. D HDR
  1. Q
  1. HDR ;Header for 80 col.
  1. S LRPAG=LRPAG+1
  1. W:$D(LRHDR)#2 !?((80-$L(LRHDR))/2),LRHDR,?72,"Page ",$J(LRPAG,3),!
  1. W:$D(LRHDR2)#2 ?((80-$L(LRHDR2))/2),LRHDR2,!
  1. W:$D(LRHDR3)#2 ?((80-$L(LRHDR3))/2),LRHDR3,!
  1. W:$D(LRCLHDR)#2 !,LRCLHDR,!
  1. W:$D(LRCLHDR2)#2 LRCLHDR2,!
  1. W:$D(LRCLHDR3)#2 LRCLHDR3,!
  1. W $E(LRDSHS,1,80),!
  1. Q
  1. PAUSE ;
  1. Q:$G(LREND)
  1. K DIR S DIR(0)="E" D ^DIR
  1. S:($D(DTOUT))!($D(DUOUT)) LREND=1
  1. Q