| [613] | 1 | LRLL2 ;SLC/RWF - LOAD LIST BUILD ;2/6/91 07:45 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**99,116**;Sep 27, 1994
|
|---|
| 3 | A W " BUILDING",! S LRTRACNT=$S(LRTYPE:LRTRAY,1:LRCUP+1)+LRTRACNT,LREND=0 F LRUS=0:0 S LRUS=$O(^TMP($J,-1,LRUS)) Q:LRUS=""!LREND F LRAN=0:0 S LRAN=$O(^TMP($J,-1,LRUS,LRAN)) Q:LRAN=""!LREND D FILL
|
|---|
| 4 | S LRPTRAY=LRTRAY,LRPCUP=LRCUP F LRTI=0:0 X LRTRANS Q:'$D(LRCTRL(LRTRAY,LRCUP))!(LRPTRAY'=LRTRAY) D CONTROL^LRLL4 S LRTI=1
|
|---|
| 5 | S:'LRTI LRTRAY=LRPTRAY,LRCUP=LRPCUP
|
|---|
| 6 | F LRIIX=0:0 S LRIIX=$O(^LRO(68.2,LRINST,10,LRPROF,5,LRIIX)) Q:LRIIX<1 S LRIFN=+^(LRIIX,0),LRCT=LRIFN D CTRLTST^LRLL3 S LRTST=$P(X,U,2,99) D GNCUP,LRCTRL^LRLL4
|
|---|
| 7 | D MOVE:'LRFULL!((LRCUP=LRMAXCUP)!(LRCUP<LRPCUP)) W !,"BUILD DONE"
|
|---|
| 8 | ;F LRAA=0:0 S LRAA=$O(LRAA(LRAA)) Q:LRAA'>0 S ^LRO(68,LRAA,.7)=0
|
|---|
| 9 | Q
|
|---|
| 10 | GNCUP ;from LRLL1
|
|---|
| 11 | X LRTRANS S:$S(LRTYPE:LRTRAY,1:LRCUP)'<LRTRACNT LREND=1 G GNCUP:$D(^TMP($J,LRTRAY,LRCUP))!$D(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)) ;GET NEXT LRCUP
|
|---|
| 12 | Q
|
|---|
| 13 | FILL D GNCUP Q:LREND I LRCUP<LRPCUP D MOVE
|
|---|
| 14 | I $D(LRCTRL(LRTRAY,LRCUP)) D CONTROL^LRLL4 S LRPCUP=LRCUP G FILL
|
|---|
| 15 | W "." S ^TMP($J,LRTRAY,LRCUP)=^TMP($J,-1,LRUS,LRAN)
|
|---|
| 16 | F I=0:0 S I=$O(^TMP($J,-1,LRUS,LRAN,I)) Q:I="" S ^TMP($J,LRTRAY,LRCUP,I)=^TMP($J,-1,LRUS,LRAN,I)
|
|---|
| 17 | S LRPCUP=LRCUP Q
|
|---|
| 18 | MOVE S LRLL1=$O(^TMP($J,0)) Q:LRLL1="" S LRCNT=LRCNT+1
|
|---|
| 19 | S ^LRO(68.2,LRINST,1,0)="^68.21^"_LRLL1_U_LRLL1,^(LRLL1,0)=LRLL1_U_DT_U_DUZ_U_LRAA
|
|---|
| 20 | S ^LRO(68.2,LRINST,1,LRLL1,1,0)="^68.22PA^1^1"
|
|---|
| 21 | F LRLL2=0:0 S LRLL2=$O(^TMP($J,LRLL1,LRLL2)) Q:LRLL2="" S LRLLX=^(LRLL2) D MV1
|
|---|
| 22 | K ^TMP($J,LRLL1) S LRPCUP=LRCUP W !,"B" Q
|
|---|
| 23 | MV1 S ^LRO(68.2,LRINST,1,LRLL1,1,LRLL2,0)=LRLLX
|
|---|
| 24 | F LRLL3=0:0 S LRLL3=$O(^TMP($J,LRLL1,LRLL2,LRLL3)) Q:LRLL3="" S LRTX=^(LRLL3) D MV2
|
|---|
| 25 | K ^TMP($J,LRLL1,LRLL2) Q
|
|---|
| 26 | MV2 Q:'LRAD S ^LRO(68.2,LRINST,1,LRLL1,1,LRLL2,1,0)="^68.222^"_LRLL3_"^1",^(LRLL3,0)=LRTX,$P(^LRO(68,LRAA,1,LRAD,1,$P(LRLLX,U,3),4,LRLL3,0),U,3)=LRINST_";"_LRLL1_";"_LRLL2
|
|---|
| 27 | Q
|
|---|
| 28 | TC1 IF '$P(T1,U,3),'$P(T1,U,5),$D(LRTP(+T1)),(LRTP(+T1)=LRSP!(LRTP(+T1)=""))
|
|---|
| 29 | 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
|
|---|
| 30 | Q
|
|---|
| 31 | TCHK ;check that test ordered is in profile, from LRLL4
|
|---|
| 32 | Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) I 'LRLLP(1) Q:'$P(^(3),U,3)
|
|---|
| 33 | K LRTSL S E=0,LRUS=$S($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,3)'=LRAD:LRHOLD,1:99),LRSP=$S($D(^(5,1,0)):+^(0),1:0) Q:$D(LRDSPEC(LRSP))
|
|---|
| 34 | S I1=0 F S I1=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I1)) Q:I1<1 S T1=^(I1,0) D TC1 Q:E
|
|---|
| 35 | Q:'$D(LRTSL)!E X LRURX I $T S ^TMP($J,-1,LRUS,LRAN)=LRAA_U_LRAD_U_LRAN_U_LRPROF S I=0 F S I=$O(LRTSL(I)) Q:I<1 S ^TMP($J,-1,LRUS,LRAN,I)=LRTSL(I)
|
|---|
| 36 | Q
|
|---|
| 37 | AC S LRTK=LRSTAR-.00001 F S LRTK=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK)) Q:LRTK<1!(+LRLST>1&(LRTK\1>+LRLST)) D AC1
|
|---|
| 38 | Q
|
|---|
| 39 | AC1 S LRAN=0 F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK,LRAN)) Q:LRAN<1 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2 S LRADD=1,LRDFN=+^(0),LRDPF=$P(^(0),U,2),LRIDT=9999999-$S($D(^(3)):^(3),1:0) D TCHK
|
|---|
| 40 | Q
|
|---|
