source: FOIAVistA/trunk/r/LIBRARY-LBR-LBRS/LBRYRPT0.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1LBRYRPT0 ;ISC2/DJM-LIBRARY TECHNICIAN REPORTS ;[ 05/23/97 12:13 PM ]
2 ;;2.5;Library;**2**;Mar 11, 1996
3MED ;MEDICAL TITLES BY SUBJECT OR WITHOUT & BY DETAILED OR BRIEF HOLDINGS
4 S TEXT="Local Medical Holdings" D HEAD G EXIT:$G(DUOUT)=1
5MED0 W "Do you want MEDICAL HOLDINGS listed by TITLE" S %=1 D YN^DICN
6 G:%=1 MED1 G:%=2 MED4 G:%=-1 EXIT
7 W !!,"Yes will list medical holdings by title."
8 W !,"No will list medical holdings by subject.",!!
9 G MED0
10MED1 W !,"Do you want DETAILED HOLDINGS listed" S %=1 D YN^DICN
11 S DIS(0)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
12 S FLDS=$S(%=1:"[LBRY MEDICAL HOLDINGS]",%=2:"[LBRY BRIEF MEDICAL HOLDINGS]",1:"") G:%=-1 EXIT G:%=0 MED3
13MED2 S L=0,DIC="^LBRY(680,",BY="[LBRY MEDICAL HOLDINGS]" D EN1^DIP G EXIT
14MED3 D YN G MED1
15MED4 W !,"Do you want DETAILED HOLDINGS listed" S %=1 D YN^DICN
16 S FLDS=$S(%=1:"[LBRY MEDICAL BY SUBJECT]",%=2:"[LBRY BRIEF MEDICAL/SUBJECT]",1:"") G:%=-1 EXIT G:%=0 MED5
17 S L=0,DIC="^LBRY(680,",BY="[LBRY MEDICAL BY SUBJECT]"
18 S DIS(0)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
19 D EN1^DIP G EXIT
20MED5 D YN G MED4
21MSC ;CURRENT MEDICAL SUBSCRIPTIONS BY SUBJECT WITH COST
22 S TEXT="Medical Holdings with Cost" D HEAD G EXIT:$G(DUOUT)=1
23 S L=0,DIC="^LBRY(680,",FLDS="[LBRY MEDICAL SUBSCRIPTIONS]"
24 S DIS(0)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
25 S BY="[LBRY MEDICAL SUBSCRIPTIONS]" D EN1^DIP
26 G EXIT
27LDT ;LOCAL DONOR TITLES
28 S TEXT="Local Donor Titles" D HEAD G EXIT:$G(DUOUT)=1
29 S L=0,DIC="^LBRY(681,",FLDS="[LBRY DONOR TITLES]"
30 S DIS(0)="I $P($G(^LBRY(681,D0,0)),U,4)=LBRYPTR"
31 S BY="[LBRY DONOR TITLES]" D EN1^DIP
32 G EXIT
33LPS ;LISTING OF ALL CURRENT PATIENTS' SUBSCRIPTIONS
34 S TEXT="Patients' Subscriptions" D HEAD G EXIT:$G(DUOUT)=1
35 S L=0,DIC="^LBRY(680,",FLDS="[LBRY PATIENT HOLDINGS]"
36 S BY="[LBRY PATIENT HOLDINGS]"
37 S DIS(0)="I $S($O(^LBRY(680,D0,4,""B"",""G"",0)):1,$O(^LBRY(680,D0,4,""B"",""P"",0)):1,1:0)"
38 S DIS(1)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
39 D EN1^DIP
40 G EXIT
41LAT ;LOCAL ADMINISTRATIVE TITLES BY LOCATION
42 S TEXT="Local Administrative Titles" D HEAD G EXIT:$G(DUOUT)=1
43 S L=0,DIC="^LBRY(680,",FLDS="[LBRY ADMIN TITLES]"
44 S DIS(0)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
45 S BY="[LBRY ADMIN TITLES]" D EN1^DIP
46 G EXIT
47LPT ;ALL PATIENT HOLDINGS, BRIEF OR DETAILED HOLDINGS
48 S TEXT="Patient Library Holdings" D HEAD G EXIT:$G(DUOUT)=1
49LPT0 W "Do you want all general and patient health education titles"
50 S %=1 D YN^DICN G:%=1 LPT1 G:%=2 LPT4 G:%=-1 EXIT
51 W !!,"Yes will list all non-medical titles."
52 W !,"No will list all patient health education titles only.",!!
53 G LPT0
54LPT1 W !,"Do you want DETAILED HOLDINGS listed" S %=1 D YN^DICN
55 S FLDS=$S(%=1:"[LBRY PATIENT TITLES]",%=2:"[LBRY PATIENT TITLES BRIEF]",1:"") G:%=-1 EXIT G:%=0 LPT3
56LPT2 S L=0,DIC="^LBRY(680,",BY="[LBRY PATIENT TITLES]"
57 S DIS(0)="I $S($O(^LBRY(680,D0,4,""B"",""G"",0)):1,$O(^LBRY(680,D0,4,""B"",""P"",0)):1,1:0)"
58 S DIS(1)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
59 D EN1^DIP G EXIT
60LPT3 D YN G LPT1
61LPT4 W !,"Do you want DETAILED HOLDINGS listed" S %=1 D YN^DICN
62 S FLDS=$S(%=1:"[LBRY PATIENT TITLES]",%=2:"[LBRY PATIENT TITLES BRIEF]",1:"") G:%=-1 EXIT G:%=0 LPT5
63 S L=0,DIC="^LBRY(680,",BY="[LBRY PATIENT TITLES BRIEF]"
64 S DIS(0)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
65 S DHD=$S(%=1:"Local Patient Holdings, PHE only",1:"Local Patient Brief Holdings, PHE only")
66 D EN1^DIP G EXIT
67LPT5 D YN G LPT4
68ART ;LISTING OF ADMINISTRATIVE TITLES WITH RECIPIENTS
69 S TEXT="Administrative Recipients" D HEAD G EXIT:$G(DUOUT)=1
70 S L=0,DIC="^LBRY(681,",FLDS="[LBRY ADMIN RECIPIENTS]"
71 S DIS(0)="I $P($G(^LBRY(681,D0,0)),U,4)=LBRYPTR"
72 S BY="[LBRY ADMIN RECIPIENTS]" D EN1^DIP
73 G EXIT
74TUL ;UNION LISTS WITH COMPLETE OR BRIEF HOLDINGS
75 S TEXT="Union List with Holdings" D HEAD G EXIT:$G(DUOUT)=1
76TUL0 W "Do you want DETAILED HOLDINGS listed" S %=1 D YN^DICN
77 S FLDS=$S(%=1:"[LBRY UNION LIST CODE]",%=2:"[LBRY UNION LIST BRIEF]",1:"") G:%=-1 EXIT G:%=0 TUL1
78 S DIS(0)="I $P($G(^LBRY(680,D0,0)),U,4)=LBRYPTR"
79 S L=0,DIC="^LBRY(680,",BY="[LBRY UNION LIST CODE]" D EN1^DIP
80 G EXIT
81TUL1 D YN G TUL0
82NLT ;NEW LOCAL TITLES IN TITLE AUTHORITY FILE
83 S TEXT="New Local Titles" D HEAD G EXIT:$G(DUOUT)=1
84 S L=0,DIC="^LBRY(680.5,",FLDS="[LBRY NEW LOCAL TITLES]"
85 S BY="[LBRY NEW LOCAL TITLES]" D EN1^DIP G EXIT
86HEAD I $G(LBRYPTR)="" S DUOUT=1 Q
87 W @IOF,"VA Library Serials "_TEXT_" for "_LBRYNAM_" "
88 S Y=DT X ^DD("DD") W Y,!!
89 Q
90YN W !!,"Yes will present a complete description of the title's holdings."
91 W !,"No will present a brief description of the title's holdings.",!
92 Q
93EXIT I IOT="TRM" R !!,"Press return to continue: ",LBRYC:DTIME
94 K L,DIC,FLDS,BY,TEXT,%,Y,DIS,DHD,LBRYC,DUOUT
95 Q
Note: See TracBrowser for help on using the repository browser.