LRPHLIST ;VA/SLC/CJS - PRINT COLLECTION LIST ; 13-Aug-2013 09:09 ; MKK
;;5.2;LAB SERVICE;**1018,398,1033**;NOV 01, 1997;Build 176
;
;;VA Patches: 161,398 ;Sep 27, 1994;Build 3
;
K IO("Q"),LRBAR,LRLABLIO
S U="^",X="NOW",%DT="T",LRLL=1 D ^%DT D DD^LRX S LRDT0=Y
I $P(^LAB(69.9,1,5),U,10) D Q
. W !,$C(7),"Collection list is STILL BUILDING."
. D QUIT
S LRDIV=$S($G(DUZ(2)):DUZ(2),1:+$$GET1^DIQ(4.3,1_",",217,"I")) ;multidivision
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
S LRSTA=0,LRFIN=""
I '$D(ZTQUEUED) D LOC G:X["^" QUIT
I LRLL=2 S IOP=LRLABLIO I '$G(LRLABLIO("Q")) S %ZIS="Q" D ^%ZIS K %ZIS,IOP G LRPHLIST:POP
I LRLL=1,'$D(ZTQUEUED) K IOP S %ZIS="Q" D ^%ZIS G LRPHLIST:POP
I $D(IO("Q"))!(LRLL=2&$G(LRLABLIO("Q"))) D G END
. S ZTRTN="DQ^LRPHLIST",ZTDESC="Collection list",ZTSAVE("LR*")="",ZTSAVE("DT")=""
. I LRLL=2 S ZTIO=LRLABLIO
. D ^%ZTLOAD
. D ^%ZISC
;
DQ U IO
S $P(^LAB(69.9,1,5),"^",15)=1+$S($L($P(^LAB(69.9,1,5),"^",15)):$P(^(5),"^",15),1:0)
S:$D(ZTQUEUED) ZTREQ="@" W:LRLL=1 !! S LRPR=0 D ^LRPHLIS1
U IO W:LRLL=1 !
END D ^%ZISC Q:$D(LRLABLTF)
K LRBAR,LRLABLIO,LRWLEC,IOP,LRPHLISF,LRXL,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,IO("Q")
G:'$D(ZTQUEUED) LRPHLIST
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
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
K LRRB,LRLLOC,LRDIV,LRDIVLOC,LRMULTI,LRBAR,LRBAR0,LRBAR1
Q
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
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
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_" ")
Q
LRPHLIST ;VA/SLC/CJS - PRINT COLLECTION LIST ; 13-Aug-2013 09:09 ; MKK
+1 ;;5.2;LAB SERVICE;**1018,398,1033**;NOV 01, 1997;Build 176
+2 ;
+3 ;;VA Patches: 161,398 ;Sep 27, 1994;Build 3
+4 ;
+5 KILL IO("Q"),LRBAR,LRLABLIO
+6 SET U="^"
SET X="NOW"
SET %DT="T"
SET LRLL=1
DO ^%DT
DO DD^LRX
SET LRDT0=Y
+7 IF $PIECE(^LAB(69.9,1,5),U,10)
Begin DoDot:1
+8 WRITE !,$CHAR(7),"Collection list is STILL BUILDING."
+9 DO QUIT
End DoDot:1
QUIT
+10 ;multidivision
SET LRDIV=$SELECT($GET(DUZ(2)):DUZ(2),1:+$$GET1^DIQ(4.3,1_",",217,"I"))
+11 IF '$DATA(ZTQUEUED)
WRITE !,"1 LIST",!,"2 LABELS",!!,"Choose: "
READ LRLL:DTIME
IF '$TEST!(LRLL="^")!(LRLL="")
GOTO QUIT
IF LRLL="?"
WRITE !!,"Enter ""1"" or ""2""",!
IF (LRLL>2)!(LRLL<1)
GOTO LRPHLIST
IF LRLL=2
SET LRPHLISF=2
DO ^LRLABLIO
IF '$DATA(LRLABLIO)
KILL LRPHLISF
GOTO LRPHLIST
+12 SET LRSTA=0
SET LRFIN=""
+13 IF '$DATA(ZTQUEUED)
DO LOC
IF X["^"
GOTO QUIT
+14 IF LRLL=2
SET IOP=LRLABLIO
IF '$GET(LRLABLIO("Q"))
SET %ZIS="Q"
DO ^%ZIS
KILL %ZIS,IOP
IF POP
GOTO LRPHLIST
+15 IF LRLL=1
IF '$DATA(ZTQUEUED)
KILL IOP
SET %ZIS="Q"
DO ^%ZIS
IF POP
GOTO LRPHLIST
+16 IF $DATA(IO("Q"))!(LRLL=2&$GET(LRLABLIO("Q")))
Begin DoDot:1
+17 SET ZTRTN="DQ^LRPHLIST"
SET ZTDESC="Collection list"
SET ZTSAVE("LR*")=""
SET ZTSAVE("DT")=""
+18 IF LRLL=2
SET ZTIO=LRLABLIO
+19 DO ^%ZTLOAD
+20 DO ^%ZISC
End DoDot:1
GOTO END
+21 ;
DQ USE IO
+1 SET $PIECE(^LAB(69.9,1,5),"^",15)=1+$SELECT($LENGTH($PIECE(^LAB(69.9,1,5),"^",15)):$PIECE(^(5),"^",15),1:0)
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
IF LRLL=1
WRITE !!
SET LRPR=0
DO ^LRPHLIS1
+3 USE IO
IF LRLL=1
WRITE !
END DO ^%ZISC
IF $DATA(LRLABLTF)
QUIT
+1 KILL LRBAR,LRLABLIO,LRWLEC,IOP,LRPHLISF,LRXL,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,IO("Q")
+2 IF '$DATA(ZTQUEUED)
GOTO LRPHLIST
QUIT KILL %,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
+1 KILL 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
+2 KILL LRRB,LRLLOC,LRDIV,LRDIVLOC,LRMULTI,LRBAR,LRBAR0,LRBAR1
+3 QUIT
LOC READ !!,"Starting Location: ",X:DTIME
IF X=" "
SET X=""
IF X="^"
QUIT
SET LRSTA=X
IF X="?"
WRITE !,"Enter the abbreviation for the location you want to start with.",!,"Just enter return if you want to start at the beginning."
GOTO LOC
LOC1 READ !,"Ending location: ",X:DTIME
IF X=" "
SET X=""
IF X="^"
QUIT
SET LRFIN=X
IF X="?"
WRITE !,"Enter the abbreviation for the location you want to end with.",!,"Just enter return if you want to print to the end."
GOTO LOC1
+1 SET LRSTA=$SELECT(0[LRSTA:-1,+LRSTA=LRSTA:LRSTA-.000001,1:$EXTRACT(LRSTA,1,$LENGTH(LRSTA)-1)_$CHAR($ASCII(LRSTA,$LENGTH(LRSTA))-1))
SET LRFIN=$SELECT(0[LRFIN:"",+LRFIN=LRFIN:LRFIN+.000001,1:LRFIN_" ")
+2 QUIT
