LRLLP3.m

LRLLP3 ;SLC/RWF/MILW/JMC - SEQUENCE LIST PRINT ;2/5/91  14:38 ;

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

LOOP S (LRFSTP,LRTRAY)=1,LRCUP=LRST,LRPROF=+$O(^LRO(68.2,LRINST,1,LRTRAY,1,0)) G:'LRPROF ERR G:'$D(^LRO(68.2,LRINST,1,LRTRAY,1,LRPROF,0))#2 ERR S LRPROF=+$P(^(0),U,4)

 D HED^LRLLP2:LRFRMT="C",HED^LRLLP5:LRFRMT="E" Q:$G(LREXIT)

LP2 S LRCUP=$O(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP)) G END:(LRCUP>LRLLT)!(LRCUP<1) S LRLL=$S($D(^(LRCUP,0)):^(0),1:""),LRTEST="" S:LRPROF'=+$P(LRLL,U,4) LRPROF=+$P(LRLL,U,4),LRDC=1

 I $Y+8>IOSL!LRDC D HED^LRLLP2:LRFRMT="C",HED^LRLLP5:LRFRMT="E" Q:$G(LREXIT)

 W ! W:'LRALTH "SEQ: ",$J(LRCUP,4) D LRLINE^LRLLP2:LRFRMT="C",LRLINE^LRLLP5:LRFRMT="E" G LP2

 Q

 S LRDC=0 Q

ERR ;

 W !?10,"There is not a profile defined for this LOAD/WORK LIST ",!!

END I $E(IOST,1,2)="C-",'$G(LREXIT) D TERM^LRLLP2

 W ! W:$E(IOST,1,2)="P-" @IOF

 D ^%ZISC Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRLLP3   876     printed  Apr 09, 2024@21:21:46                                                                                                                                                                                                       Page 2

LRLLP3    ;SLC/RWF/MILW/JMC - SEQUENCE LIST PRINT ;2/5/91  14:38 ;

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

LOOP       SET (LRFSTP,LRTRAY)=1

           SET LRCUP=LRST

           SET LRPROF=+$ORDER(^LRO(68.2,LRINST,1,LRTRAY,1,0))

           if 'LRPROF

               GOTO ERR

           if '$DATA(^LRO(68.2,LRINST,1,LRTRAY,1,LRPROF,0))#2

               GOTO ERR

           SET LRPROF=+$PIECE(^(0),U,4)

 +1        if LRFRMT="C"

               DO HED^LRLLP2

           if LRFRMT="E"

               DO HED^LRLLP5

           if $GET(LREXIT)

               QUIT 

LP2        SET LRCUP=$ORDER(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP))

           if (LRCUP>LRLLT)!(LRCUP<1)

               GOTO END

           SET LRLL=$SELECT($DATA(^(LRCUP,0)):^(0),1:"")

           SET LRTEST=""

           if LRPROF'=+$PIECE(LRLL,U,4)

               SET LRPROF=+$PIECE(LRLL,U,4)

               SET LRDC=1

 +1        IF $Y+8>IOSL!LRDC

               if LRFRMT="C"

                   DO HED^LRLLP2

               if LRFRMT="E"

                   DO HED^LRLLP5

               if $GET(LREXIT)

                   QUIT 

 +2        WRITE !

           if 'LRALTH

               WRITE "SEQ: ",$JUSTIFY(LRCUP,4)

           if LRFRMT="C"

               DO LRLINE^LRLLP2

           if LRFRMT="E"

               DO LRLINE^LRLLP5

           GOTO LP2

 +3        QUIT 

 +4        SET LRDC=0

           QUIT 

ERR       ;

 +1        WRITE !?10,"There is not a profile defined for this LOAD/WORK LIST ",!!

END        IF $EXTRACT(IOST,1,2)="C-"

               IF '$GET(LREXIT)

                   DO TERM^LRLLP2

 +1        WRITE !

           if $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

 +2        DO ^%ZISC

           QUIT