source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLLP3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 862 bytes
Line 
1LRLLP3 ;SLC/RWF/MILW/JMC - SEQUENCE LIST PRINT ;2/5/91 14:38 ;
2 ;;5.2;LAB SERVICE;**116**;Sep 27, 1994
3LOOP 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)
4 D HED^LRLLP2:LRFRMT="C",HED^LRLLP5:LRFRMT="E" Q:$G(LREXIT)
5LP2 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
6 I $Y+8>IOSL!LRDC D HED^LRLLP2:LRFRMT="C",HED^LRLLP5:LRFRMT="E" Q:$G(LREXIT)
7 W ! W:'LRALTH "SEQ: ",$J(LRCUP,4) D LRLINE^LRLLP2:LRFRMT="C",LRLINE^LRLLP5:LRFRMT="E" G LP2
8 Q
9 S LRDC=0 Q
10ERR ;
11 W !?10,"There is not a profile defined for this LOAD/WORK LIST ",!!
12END I $E(IOST,1,2)="C-",'$G(LREXIT) D TERM^LRLLP2
13 W ! W:$E(IOST,1,2)="P-" @IOF
14 D ^%ZISC Q
Note: See TracBrowser for help on using the repository browser.