source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRLLP.m@ 1211

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1LRLLP ;SLC/RWF - LOAD LIST PRINT ;2/19/91 10:43 ;
2 ;;5.2;LAB SERVICE;**116**;Sep 27, 1994
3 K DIC,ZTSK,%ZIS,LRTEST W !!,"PRINT LOAD/WORK LIST"
4 S DIC="^LRO(68.2,",DIC(0)="QAEMZ",DIC("S")="S %=$P(^(0),U,12) X ""I '$L(%)"" Q:$T S %=$P(^DIC(19.1,%,0),U,1) I $D(^XUSEC(%,DUZ))" D ^DIC G KILL:Y<1 S LRINST=+Y,LRTYPE=$P(Y(0),U,3),LRMAXCUP=$P(Y(0),U,4)
5 S U="^",LRST=1,LRLLT=9999999 D DT^LRX S LRAD=DT
6AS W !,"(C)ondensed or (E)xpanded list ? (req. 132 column format):C//" R LRFRMT:DTIME Q:'$T!(LRFRMT[U) S LRFRMT=$E(LRFRMT) S:LRFRMT']"" LRFRMT="C" I LRFRMT'="C"&(LRFRMT'="E") W !,"Answer C or E" G AS
7EN1 ;from LRLL1
8 D EN2
9KILL ;from LRLL1
10 K LREXIT
11 K A,IO("Q"),AGE,DFN,DIC,DIB,I,J,K,LAST,LRACC,LRAD,LRALTH,LRAN,LRCUP,LRFRMT,%,%H,DA,L,LRNOW,LRTSTLM
12 K LRDC,LRDFN,LRDOC,LRDPF,LRIDT,LRINST,LRLINE,LRLL,LRLLOC,LRLLT
13 K LRMAXCUP,LRODNUM,LRORD,LRPROF,LRSHORT,LRSPEC,LRST,LRTEST,LRTRAY
14 K ^TMP("LR",$J,"T"),LRTSTS,LRTYPE,LRURG,LRV,LRWRD,LRXPD,PNM,SEX,SSN,X,Y,Z,LRSISPEC
15 Q
16EN2 ;ENTRY FROM LRLL2
17 S U="^",X=^LRO(68.2,LRINST,0),LRTYPE=$P(X,U,3),LRXPD=$P(X,U,6),LRLINE="",LRALTH=$P(X,U,9),LRDC=1,LRSHORT=$P(X,U,11),$P(LRLINE,"-",40)=""
18 I $S($D(^LRO(68.2,LRINST,2)):$P(^(2),U,1),1:0)'=LRAD W !,"LOAD/WORK LIST NOT SETUP FOR THIS DATE"
19 S LAST=$S($D(^LRO(68.2,LRINST,2)):^(2),1:"^1^1^^"),LRST=$P(LAST,U,$S(LRTYPE:2,1:3)),LRLLT=99999 G LR3:$D(ZTQUEUED)
20LR1 W !,$S(LRTYPE=1:"TRAY",1:"SEQUENCE")," # TO START WITH:",LRST,"//" R X:DTIME I X["?" W !?5,"Enter number to start with.",! G LR1
21 S LRST=$S(X="":LRST,X:+X,1:-1) Q:LRST<1
22 IF LRTYPE,'$D(^LRO(68.2,LRINST,1,LRST,0)) W $C(7)," NOT SETUP YET" G LR1
23LR2 W !?$S(LRTYPE=1:12,1:17),"END WITH: LAST//" R LRLLT:DTIME I LRLLT["?" W !?5,"Enter number to end with",! G LR2
24 S LRLLT=$S(LRLLT="":999999,LRLLT:+LRLLT,1:-1) Q:LRLLT<1
25LR3 S LRST=LRST-.5 S:'LRTYPE LRTRAY=1,LRCUP=LRST S:LRTYPE LRTRAY=LRST,LRCUP=0
26 I LRTYPE S X=$O(^LRO(68.2,LRINST,1,LRST)) G EMPTY:X<1,EMPTY:$O(^LRO(68.2,LRINST,1,X,1,0))<1
27 I 'LRTYPE S X=$O(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP)) G EMPTY:X<1
28 I '$D(ZTQUEUED) S %ZIS="MQ" D ^%ZIS Q:POP
29 G QUE:$D(IO("Q"))
30LR4 D URG^LRX K ^TMP($J)
31 S %DT="T",X="N" D ^%DT,DD^LRX S LRNOW=Y
32 U IO
33 G ^LRLLP3:'LRTYPE,^LRLLP5:LRFRMT="E",^LRLLP2:LRFRMT="C"
34 Q
35EMPTY W !!,"The list is EMPTY and can't be printed",! Q
36QUE S ZTRTN="DQ^LRLLP",ZTSAVE("LR*")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTSAVE Q
37DQ S:$D(ZTQUEUED) ZTREQ="@" U IO D LR4,KILL Q
Note: See TracBrowser for help on using the repository browser.