- 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
