- 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
