source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRPHLIST.m@ 724

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1LRPHLIST ;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 ;
20DQ 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 !
24END 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
27QUIT 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
31LOC 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
32LOC1 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
Note: See TracBrowser for help on using the repository browser.