source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYRPT1.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: 1.9 KB
Line 
1LBRYRPT1 ;ISC2/DJM - PATRON REPORTS ;[ 06/11/97 1:16 PM ]
2 ;;2.5;Library;**2,5**;Mar 11, 1996
3JTA ;
4 I $G(LBRYPTR)="" D I $G(LBRYPTR)="" W !!,$C(7),"No Site has been selected" G EXIT
5 . D ^LBRYASK
6 D NOW^%DTC S Y=%\1 X ^DD("DD")
7 W @IOF,"VA Library Patron Journal Title for "_LBRYNAM_" "_Y,!
8 S DIC="^LBRY(680.5,",DIC(0)="AEMQ"
9 S DIC("S")="I $P(^LBRY(680.5,+Y,0),U,2)]"""""
10 D ^DIC K DIC("S") G:Y<0 FINI S LBRYNUM=$P(Y,U,2)
11 S (FR,TO)=LBRYNUM,BY=.01,FLDS="[LBRY PATRON TITLES]",L=0
12 D EN1^DIP G FINI
13SLJ ;
14 I $G(LBRYPTR)="" D I $G(LBRYPTR)="" W !!,$C(7),"No Site has been selected" G EXIT
15 . D ^LBRYASK
16 D NOW^%DTC S Y=%\1 X ^DD("DD")
17 W @IOF,"VA Library Patron Subject List for "_LBRYNAM_" "_Y,!
18 S DIC="^LBRY(680.3,",DIC(0)="AEQ" D ^DIC G:Y<0 FINI
19 S LBRYSN=+Y,LBRYNM=$P(Y,U,2)
20QUEUE S %ZIS="MQ" K IO("Q") D ^%ZIS G:POP FINI I '$D(IO("Q")) U IO
21 D SLJ1^LBRYRPT1 D ^%ZISC G FINI
22QUEUE1 S ZTRTN="SLJ1^LBRYRPT1",ZTSAVE("LBRYSN")="",ZTSAVE("LBRYNM")=""
23 K IO("Q") D ^%ZTLOAD D ^%ZISC K ZTSK
24FINI K DIC,FR,TO,BY,FLDS,L,LBRYNUM,LBRYSN,LBRYNM,POP,Y,%ZIS,%
25 Q
26SLJ1 K ^TMP($J,"LBRYSLJ") S X=""
27SL S X=$O(^LBRY(680,"C",LBRYSN,X)) G:X="" SLJ2
28 I $P(^LBRY(680,X,0),U,4)'=LBRYPTR G SL
29 S LBR6805=$P(^LBRY(680,X,0),U)
30 S NM=$P(^LBRY(680.5,LBR6805,0),U) S:$E(NM,1,4)="THE " NM=$E(NM,5,999)
31 S ^TMP($J,"LBRYSLJ",$E(NM,1,60))=NM
32 G SL
33SLJ2 S PG=1 D NOW^%DTC S Y=% X ^DD("DD")
34 S LBDT=$P(Y,"@",1)_" "_$P(Y,"@",2) G PRINT
35H0 G:IO'=IO(0)!($D(ZTSK)) H R LZ:DTIME E S LZ="^" Q
36 Q:LZ["^"
37H W @IOF,"Subject List of Journals Available",?47,LBDT,?69,"PAGE ",PG,!
38 S PG=PG+1
39 F I=1:1:80 W "-"
40 W !!,"SUBJECT: ",LBRYNM,!
41 Q
42T W ! Q
43PRINT S LZ="" D H
44 F S X=$O(^TMP($J,"LBRYSLJ",X)) Q:X="" D Q:LZ["^"
45 . S X1=^TMP($J,"LBRYSLJ",X),LN=$L(X1)+8,NU=LN\80,NU=$S(LN#80>0:NU+1,1:NU)
46 . D:$Y+NU>(IOSL-2) H0 Q:LZ["^" D T W "TITLE: ",X1
47EXIT K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK
48 K X,X1,I,XP,%,LN,LZ,NU,NM,PG,LBDT,Y,^TMP($J,"LBRYSLJ"),LBRYNUM,LBRYNM,LBR6805
49 Q
Note: See TracBrowser for help on using the repository browser.