Routine: LRLL4

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

 ;;5.2;LAB SERVICE;**459**;Sep 27, 1994;Build 1

CONTROL ;from LRLL2

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

LRCTRL ;from LRLL1, LRLL2

 N LRLBL

 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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLL4   1070     printed  Feb 18, 2025@23:42:10                                                                                                                                                                                                       Page 2

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

 +1       ;;5.2;LAB SERVICE;**459**;Sep 27, 1994;Build 1

CONTROL   ;from LRLL2

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

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

LRCTRL    ;from LRLL1, LRLL2

 +1        NEW LRLBL

 +2        SET LRPWL=LRAA

           SET LRPWDT=LRAD

           SET LRPWLE=LRAN

           SET LRODT=DT

           SET LRNOLABL=1

           SET LRSTART=LRST

           DO LOAD^LRCONJAM

           SET LRST=LRSTART

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

               WRITE !,"CONTROL FAILED TO ADD"

               QUIT

 +4        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)

 +5        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)

 +6        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

LRLL4.m