source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLL1.m@ 1073

LRLL1 ;SLC/RWF - LOAD LIST SCAN. ;2/19/91  10:42 ;

 ;;5.2;LAB SERVICE;**116**;Sep 27, 1994

L1 ;

 L +^LRO(68.2,LRINST,3) I $S($D(^LRO(68.2,LRINST,3)):^(3),1:0) W !,"Waiting for another build to finish.",$C(7),!!?5,"Type '^' to stop waiting." L -^LRO(68.2,LRINST,3) R X:DTIME G L1:X'[U Q

 G QUEUE:$D(IO("Q")) S (LRPCUP,LRAN,LRCNT)=0

 S ^LRO(68.2,LRINST,3)=1

LP D BUILD

 I $D(LRALL) S LRPROF=$O(^LRO(68.2,LRINST,10,LRPROF)) I LRPROF>0 D PROF^LRLL3 G LP

 S ^LRO(68.2,LRINST,3)=0 L -^LRO(68.2,LRINST,3) I LRCNT=0 W !,"NO ENTRYS ADDED",$C(7) G END

 S ^LRO(68.2,LRINST,2)=DT_U_$P(^LRO(68.2,LRINST,2),U,2,3)_U_LRTRAY_U_LRCUP

 W !!,"LOAD LIST IS NOW SET UP"

 K LRCTRL,LRDSPEC,^TMP($J) D EN1^LRLLP G END ;GO PRINT

BUILD W !!,"STARTING PROFILE ",$P(^LRO(68.2,LRINST,10,LRPROF,0),U,1)," SCAN",!

 I '$D(LRSTAR) S LRAD1=LRAD,LRAN=LRST-.01 F  S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)),LRADD=1 Q:LRAN<1!(LRAN>LRLLT)  I $D(^(LRAN,0))#2 S LRDFN=+^(0),LRDPF=$P(^(0),U,2),LRIDT=9999999-$S($D(^(3)):^(3),1:0) D TCHK

 I $D(LRSTAR) S LRAD1=$E(LRSTAR,1,3)-1_"0000" S A=0 F  S LRAD1=$O(^LRO(68,LRAA,1,LRAD1)) Q:LRAD1<1!(LRAD1>LRWDTL)  D AC

 I $O(^TMP($J,-1,0))="" W !,"NO ENTRY FOUND!",! Q

 F LRIIX=0:0 S LRIIX=$O(^LRO(68.2,LRINST,10,LRPROF,4,LRIIX)) Q:LRIIX<1  S LRIFN=+^(LRIIX,0),LRCT=LRIFN D CTRLTST^LRLL3 S LRTST=$P(X,U,2,99) D GNCUP^LRLL2,LRCTRL^LRLL4

 W !,"SCAN DONE." D ^LRLL2

 Q

TC1 IF '$P(T1,U,3),'$P(T1,U,5),$D(LRTP(+T1)),(LRTP(+T1)=LRSP!(LRTP(+T1)=""))

 S:'$T&('LRSPLIT) E=1 I $T S LRTSL(I1)=T1,LRUS=$S(LRUS>$P(T1,U,2):+$P(T1,U,2),1:LRUS) Q

 Q

TCHK ;CHECK THAT TEST ORDERED IS IN PROFILE

 Q:'$D(^LRO(68,LRAA,1,LRAD1,1,LRAN,3))  I 'LRLLP(1) Q:'$P(^(3),U,3)

 K LRTSL S E=0,LRUS=$S($P(^LRO(68,LRAA,1,LRAD1,1,LRAN,0),U,3)'=LRAD1:LRHOLD,1:99),LRSP=$S($D(^(5,1,0)):+^(0),1:0) Q:$D(LRDSPEC(LRSP))

 S I1=0 F  S I1=$O(^LRO(68,LRAA,1,LRAD1,1,LRAN,4,I1)) Q:I1<1  S T1=^(I1,0) I '$L($P(^(0),U,3)) D TC1 Q:E

 Q:'$D(LRTSL)!E  X LRURX I $T S ^TMP($J,-1,LRUS,LRAN)=LRAA_U_LRAD1_U_LRAN_U_LRPROF_U_LRSP S I=0 F  S I=$O(LRTSL(I)) Q:I<1  S ^TMP($J,-1,LRUS,LRAN,I)=LRTSL(I)

 Q

AC S LRTK=LRSTAR-.00001 F  S LRTK=$O(^LRO(68,LRAA,1,LRAD1,1,"E",LRTK)) Q:LRTK<1!(+LRLST>1&(LRTK\1>+LRLST))  D AC1

 Q

AC1 S LRAN=0 F  S LRAN=$O(^LRO(68,LRAA,1,LRAD1,1,"E",LRTK,LRAN)) Q:LRAN<1  I $D(^LRO(68,LRAA,1,LRAD1,1,LRAN,0))#2 S LRADD=1,LRDFN=+^(0),LRDPF=$P(^(0),U,2),LRIDT=9999999-$S($D(^(3)):^(3),1:0) D TCHK

 Q

QUEUE L -^LRO(68.2,LRINST,3) W ! S IOP="Q" D ^%ZIS I POP K IO("Q") G L1

 I '$D(IO("Q")) G L1

 S ZTRTN="DQ^LRLL1",ZTDESC="Load list",ZTSAVE("LR*")="" D ^%ZTLOAD K ZTSK S IOP=IO(0) D ^%ZIS D KILL^LRLLP Q

DQ S U="^" U IO I $S($D(^LRO(68.2,LRINST,3)):^(3),1:0) S ZTDTH="120S",ZTIO="",ZTDESC="REQUEUE OF LOAD/WORK LIST " D REQ^%ZTLOAD Q

 L +^LRO(68.2,LRINST,3):2 I '$T S ZTDTH="120S",ZTIO="",ZTDESC="REQUEUE OF LOAD/WORK LIST" D REQ^%ZTLOAD Q

 S:$D(ZTQUEUED) ZTREQ="@" G L1

LOCK L -^LRO(68.2,LRINST,3) L +^LRO(68,LRAA,.7) I '$D(LRAA(LRAA)),$S($D(^LRO(68,LRAA,.7)):^(.7),1:0) W:'$D(ZTQUEUED) !,"Waiting for access to the accession area" L -^LRO(68,LRAA,.7) H 30 G LOCK

 S ^LRO(68,LRAA,.7)=1,LRAA(LRAA)="" L -^LRO(68,LRAA,.7) Q

END ;from LRLL

 K LRAA,LRDEF,LRTRANS,LRTYPE,LRURX,LRTP,LRST,LRDSPEC,LRFULL,LRHOLD,LRINST,LRLLINIT,LRLLP,LRLLT,LRMAXCUP,LRPROF,X,Y,LRAA,LRAD,LRADD,LRAD1

 K LRIIX,LRPTRAY,LRLL1,LRLLX,LRPCUP,B,DOUT,E,I1,J1,LRCNT,LRCT,LRIFN,LRIO,LRLL2,LRLL3,LRLST,LRNOLABL,LRODT,LRPGM,LRSP,LRSPLIT,LRSTART,LRTI,LRTIME,LRTK,LRTRACNT,LRTST,LRUS,LRWDTL,T1

 D KILL^LRLL Q