| 1 | LRPHLIST ;SLC/CJS - PRINT COLLECTION LIST ;2/19/91 11:13
|
|---|
| 2 | ;;5.2;LAB SERVICE;**161**;Sep 27, 1994
|
|---|
| 3 | K IO("Q"),LRBAR,LRLABLIO
|
|---|
| 4 | S U="^",X="NOW",%DT="T",LRLL=1 D ^%DT D DD^LRX S LRDT0=Y
|
|---|
| 5 | I $P(^LAB(69.9,1,5),U,10) D Q
|
|---|
| 6 | . W !,$C(7),"Collection list is STILL BUILDING."
|
|---|
| 7 | . D QUIT
|
|---|
| 8 | S LRDIV=$S($G(DUZ(2)):DUZ(2),1:+$$GET1^DIQ(4.3,1_",",217,"I")) ;multidivision
|
|---|
| 9 | I '$D(ZTQUEUED) W !,"1 LIST",!,"2 LABELS",!!,"Choose: " R LRLL:DTIME G:'$T!(LRLL="^")!(LRLL="") QUIT W:LRLL="?" !!,"Enter ""1"" or ""2""",! G LRPHLIST:(LRLL>2)!(LRLL<1) I LRLL=2 S LRPHLISF=2 D ^LRLABLIO I '$D(LRLABLIO) K LRPHLISF G LRPHLIST
|
|---|
| 10 | S LRSTA=0,LRFIN=""
|
|---|
| 11 | I '$D(ZTQUEUED) D LOC G:X["^" QUIT
|
|---|
| 12 | I LRLL=2 S IOP=LRLABLIO I '$D(IO("Q")) D ^%ZIS K %ZIS,IOP G LRPHLIST:POP
|
|---|
| 13 | I LRLL=1,'$D(ZTQUEUED) K IOP S %ZIS="Q" D ^%ZIS G LRPHLIST:POP
|
|---|
| 14 | I $D(IO("Q")) D G END
|
|---|
| 15 | . S ZTRTN="DQ^LRPHLIST",ZTDESC="Collection list",ZTSAVE("LR*")="",ZTSAVE("DT")=""
|
|---|
| 16 | . I LRLL=2 S ZTIO=LRLABLIO
|
|---|
| 17 | . D ^%ZTLOAD
|
|---|
| 18 | . D ^%ZISC
|
|---|
| 19 | ;
|
|---|
| 20 | DQ U IO
|
|---|
| 21 | S $P(^LAB(69.9,1,5),"^",15)=1+$S($L($P(^LAB(69.9,1,5),"^",15)):$P(^(5),"^",15),1:0)
|
|---|
| 22 | S:$D(ZTQUEUED) ZTREQ="@" W:LRLL=1 !! S LRPR=0 D ^LRPHLIS1
|
|---|
| 23 | U IO W:LRLL=1 !
|
|---|
| 24 | END D ^%ZISC Q:$D(LRLABLTF)
|
|---|
| 25 | K LRBAR,LRLABLIO,LRWLEC,IOP,LRPHLISF,LRXL,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,IO("Q")
|
|---|
| 26 | G:'$D(ZTQUEUED) LRPHLIST
|
|---|
| 27 | QUIT K %,A,AGE,B,DFN,DIC,DOB,H8,I,I1,J,K,L,LRAA,LRACC,LRAD,LRAN,LRCDT,LRCE,LRCOUNT,LRD,LRDAT,LRDFN,LRDPF,LRDTI,LREAL,LREM,LREND,LRFN,LRIDT,LRIN,LRINFW,LRIX,LRLABEL,LRLABLIO,LRLBLBP,LRLF,LRLL,LRILOC,LRNEW,LRNT,LRODT,LRORD,LRPH
|
|---|
| 28 | K LRPORD,LRPR,LRPRAC,LRPREF,LRPSN,LRIRB,LRSAMP,LRSN,LRSPEC,LRSSP,LRST,LRTJDATA,LRTOPP,LRTS,LRTV,LRTVOL,LRTXT,LRUNQ,LRVOL,LRWL0,LRWLC,LRWRD,N,PNM,S1,S2,SEX,SSN,T,X,Y,Z,%H,%ZA,%ZB,%ZC,LABEL,LRFIN,LRLABLTF,LRLBLD,LRNOLABL,LRSTA,LRTJ,LRTOP,ZTIO
|
|---|
| 29 | K LRRB,LRLLOC,LRDIV,LRDIVLOC,LRMULTI,LRBAR,LRBAR0,LRBAR1
|
|---|
| 30 | Q
|
|---|
| 31 | LOC R !!,"Starting Location: ",X:DTIME S:X=" " X="" Q:X="^" S LRSTA=X I X="?" W !,"Enter the abbreviation for the location you want to start with.",!,"Just enter return if you want to start at the beginning." G LOC
|
|---|
| 32 | LOC1 R !,"Ending location: ",X:DTIME S:X=" " X="" Q:X="^" S LRFIN=X I X="?" W !,"Enter the abbreviation for the location you want to end with.",!,"Just enter return if you want to print to the end." G LOC1
|
|---|
| 33 | S LRSTA=$S(0[LRSTA:-1,+LRSTA=LRSTA:LRSTA-.000001,1:$E(LRSTA,1,$L(LRSTA)-1)_$C($A(LRSTA,$L(LRSTA))-1)),LRFIN=$S(0[LRFIN:"",+LRFIN=LRFIN:LRFIN+.000001,1:LRFIN_" ")
|
|---|
| 34 | Q
|
|---|
