LRLL4.m

LRLL4 ; IHS/DIR/FJE - LOAD LIST BUILD, CONT. (Control's) 2/6/91 07:44 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

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

CONTROL ;from LRLL2

 S LRIFN=+LRCTRL(LRTRAY,LRCUP),LRTST=$P(LRCTRL(LRTRAY,LRCUP),U,2,99)

LRCTRL ;from LRLL1, LRLL2

 S LRPWL=LRAA,LRPWDT=LRAD,LRPWLE=LRAN,LRODT=DT,LRNOLABL=1,LRSTART=LRST D LOAD^LRCONJAM S LRST=LRSTART

 I '$D(^LRO(69,DT,1,LRSN,0)) W !,"CONTROL FAILED TO ADD" Q

 S I=$O(^LRO(69,DT,1,LRSN,2,0)) Q:I<1  S X=^(I,0),LRAD=$P(X,U,3),LRAA=$P(X,U,4),LRAN=$P(X,U,5)

 S ^TMP($J,LRTRAY,LRCUP)=LRAA_U_LRAD_U_LRAN_U_LRPROF_U_62.3 S I=0 F  S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1  S $P(^(I,0),U,3)=1,^TMP($J,LRTRAY,LRCUP,I)=^(0)

 S LRAA=LRPWL,LRAD=LRPWDT,LRAN=LRPWLE K LRPWL,LRPWDT,LRPWLE,LRSN W "#" Q

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

 Q

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^LRLL2

 Q

LRLL4     ; IHS/DIR/FJE - LOAD LIST BUILD, CONT. (Control's) 2/6/91 07:44 ;

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

CONTROL   ;from LRLL2

 +1        SET LRIFN=+LRCTRL(LRTRAY,LRCUP)

           SET LRTST=$PIECE(LRCTRL(LRTRAY,LRCUP),U,2,99)

LRCTRL    ;from LRLL1, LRLL2

 +1        SET LRPWL=LRAA

           SET LRPWDT=LRAD

           SET LRPWLE=LRAN

           SET LRODT=DT

           SET LRNOLABL=1

           SET LRSTART=LRST

           DO LOAD^LRCONJAM

           SET LRST=LRSTART

 +2        IF '$DATA(^LRO(69,DT,1,LRSN,0))

               WRITE !,"CONTROL FAILED TO ADD"

               QUIT 

 +3        SET I=$ORDER(^LRO(69,DT,1,LRSN,2,0))

           IF I<1

               QUIT 

           SET X=^(I,0)

           SET LRAD=$PIECE(X,U,3)

           SET LRAA=$PIECE(X,U,4)

           SET LRAN=$PIECE(X,U,5)

 +4        SET ^TMP($JOB,LRTRAY,LRCUP)=LRAA_U_LRAD_U_LRAN_U_LRPROF_U_62.3

           SET I=0

           FOR 

               SET I=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I))

               IF I<1

                   QUIT 

               SET $PIECE(^(I,0),U,3)=1

               SET ^TMP($JOB,LRTRAY,LRCUP,I)=^(0)

 +5        SET LRAA=LRPWL

           SET LRAD=LRPWDT

           SET LRAN=LRPWLE

           KILL LRPWL,LRPWDT,LRPWLE,LRSN

           WRITE "#"

           QUIT 

AC         SET LRTK=LRSTAR-.00001

           FOR 

               SET LRTK=$ORDER(^LRO(68,LRAA,1,LRAD,1,"E",LRTK))

               IF LRTK<1!(+LRLST>1&(LRTK\1>+LRLST))

                   QUIT 

               DO AC1

 +1        QUIT 

AC1        SET LRAN=0

           FOR 

               SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,"E",LRTK,LRAN))

               IF LRAN<1

                   QUIT 

               IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2

                   SET LRADD=1

                   SET LRDFN=+^(0)

                   SET LRDPF=$PIECE(^(0),U,2)

                   SET LRIDT=9999999-$SELECT($DATA(^(3)):^(3),1:0)

                   DO TCHK^LRLL2

 +1        QUIT