source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYRRS0.m@ 1078

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LBRYRRS0 ;ISC2/DJM-REPRINT ROUTING SLIPS ;[ 08/11/97 12:12 PM ]
2 ;;2.5;Library;**2**;Mar 11, 1996
3START D NOW^%DTC S LBRYD=%\1
4FRM S FROM=$O(^LBRY(682,"A3",FROM)) I FROM=""!(FROM>TO) G EXIT
5 S (Q,Q1)=0,Q=$O(^LBRY(682,"A3",FROM,Q)) D WHAT
6 G FRM
7WHAT S Q1=$O(^LBRY(682,"A3",FROM,Q,Q1)) Q:Q1'>0
8 I $P(^LBRY(682,Q,0),U,4)'=LBRYPTR G WHAT
9 S LBRYDAT=$G(^LBRY(682,Q,4,Q1,0)) I LBRYDAT'="" D TOC
10 G WHAT
11TOC S PTR=$P(LBRYDAT,U,3),PTRLST=0 G:$P(LBRYDAT,U)'="ToC" COPY
12 D HEADER
13TOC1 S PTRLST=$O(^LBRY(681,PTR,2,"AC",PTRLST)) I PTRLST'>0 D TRLR,PAUSE Q
14 S PTRL2=$O(^LBRY(681,PTR,2,"AC",PTRLST,0)) D NAME
15 G TOC1
16COPY D HEADER
17CPY S PTRLST=$O(^LBRY(681,PTR,2,"AC",PTRLST)) I PTRLST'>0 D TRLR,PAUSE Q
18 S PTRL2=$O(^LBRY(681,PTR,2,"AC",PTRLST,0)) D NAME
19 G CPY
20HEADER W @IOF,!!!!!!!!!!,?5,"Veterans Administration ROUTING SLIP"
21 W !!,?10,"ROUTE TO:",!
22 Q
23TRLR W !,?5 F K=1:1:40 W $C(42)
24 S TITLE=$P(^LBRY(681,PTR,0),U,2),TITN=$P(^LBRY(680,TITLE,0),U)
25 S TITLE=$E($P(^LBRY(680.5,TITN,0),U),1,39) W !,?5,TITLE
26 S VID=^LBRY(682,Q,1),V=$P(VID,U,2),ISSUE=$P(VID,U,3),Y=$P(VID,U) X ^DD("DD")
27 S ISSUE=$S(ISSUE]"":"("_ISSUE_")",1:"") S:V]"" ISSUE=V_ISSUE
28 W !,?5,Y,?32,ISSUE S NUMB=$P(LBRYDAT,U)
29 W:NUMB="ToC" !,?5,"TABLE of CONTENTS ROUTING SLIP"
30 W:NUMB=+NUMB !,?5,"COPY ",NUMB," ROUTING SLIP"
31 S LBRRSM=$P($G(^LBRY(680.6,LBRYPTR,0)),U,8) S:LBRRSM="" LBRRSM="142D"
32 W !!!!!,?5,"FROM LIBRARY, "_LBRRSM
33 S Y=LBRYD X ^DD("DD") W ?35,Y,!
34 Q
35NAME S NMPTR=$P(^LBRY(681,PTR,2,PTRL2,0),U)
36 S NMSVC=$S(NMPTR'="":$G(^LBRY(680.4,NMPTR,0)),1:"")
37 S NAME=$P(NMSVC,U),SVC=$P(NMSVC,U,2)
38 S SVC=$S(SVC'="":$G(^DIC(49,SVC,0)),1:"")
39 S MS=$P(SVC,U,8),SVC=$P(SVC,U)
40 W !,?5,MS,?18,NAME W:SVC]"" "/",SVC W !
41 Q
42PAUSE Q:IO'=IO(0)!($D(ZTSK)) S XZ="Continue//" D PAUSE^LBRYUTL K XZ Q
43EXIT D ^%ZISC K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK
44 K %,H,J,K,IOP,FROM,TO,Q,Q1,LBRYDAT,LBRYRET,TITLE,NUMB,LBRYD,PTR,PTRL2
45 K PTRLST,VID,V,ISSUE,Y,VI,NMPTR,NMSVC,NAME,SVC,MS,TITN,LBRRSM
46 Q
Note: See TracBrowser for help on using the repository browser.