LRLLP3.m

LRLLP3 ; IHS/DIR/FJE - SEQUENCE LIST PRINT 2/5/91 14:38 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;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

LRLLP3    ; IHS/DIR/FJE - SEQUENCE LIST PRINT 2/5/91 14:38 ;

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

 +2       ;

 +3       ;;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