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 ---[H[J[2J[HLRLLP3 876 printed Dec 13, 2024@02:16:21 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
