source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYPRCS.m@ 1432

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

initial load of WorldVistAEHR
File size: 3.0 KB
RevLine 
[613]1LBRYPRCS ;SSI/ALA-PROCESS LIBRARY TRANSACTIONS ;[ 02/07/01 1:04 PM ]
2 ;;2.5;Library;**2,8,9**;Mar 11, 1996
3 ; This is to automatically process the library transactions
4 ; received from FORUM
5 S TRN=""
6TR S TRN=$O(^LBRY(682.1,"AC","R",TRN)) G EXIT:TRN=""
7 S TYP=$P(^LBRY(682.1,TRN,0),U,2)
8 F I=1:1:4 S LDATA(I)=$G(^LBRY(682.1,TRN,I))
9 S TAF=$P(LDATA(1),U,2),LDA=$P(LDATA(1),U,3)
10 I TYP="DLT" S:$D(^LBRY(680.5,TAF,0)) $P(^(0),U,2)=2 G TR1
11 I TYP="PPR"!(TYP="CPR") D PP^LBRYPRC1 G TR1
12 I TYP="FRR"!(TYP="CFR") D FR^LBRYPRC1 G TR1
13 I TYP="PUR" D PU^LBRYPRC1 G TR1
14 I TYP="ISR" D IN^LBRYPRC1 G TR1
15 S QFL=0 S:$G(BFL)="" BFL=0 D TI I QFL G TR
16TR1 S DIC="^LBRY(682.1,",DIE=DIC,DA=TRN,DR="2///^S X=""P""" D ^DIE
17 K CHD,FX,TX,ND1,PC1,ND2,PC2,FR,TO,PF,PT,PO,GLB,IN,INP,DR,DIE,DIC,DA
18 K D,D0,X,LBRYCLS,LDATA,LDA,TAF,TYP,QFL,FLG
19 G TR
20TI ; Update a title from a transaction
21 Q:TAF="" I LDA'="",$G(^LBRY(680.5,LDA,0))="" Q
22 S TIT=$P(LDATA(1),U)
23 I $D(^LBRY(680.5,TAF,0)),TIT'[$P(^LBRY(680.5,TAF,0),U) D S QFL=1 Q
24 . S DIC="^LBRY(682.1,",DIE=DIC,DA=TRN,DR="2///^S X=""M""" D ^DIE
25 . I BFL=0 S XMB="LBRYMANL",XMY("G.LBRYUPDT")="",XMDUZ="FORUM LIBRARIANS" D ^XMB K XMY,XMDUZ,XMG S BFL=1
26 I LDA'="" S DA=LDA D ^LBRYX51
27 S LBRYCLS=TAF,$P(^LBRY(680.5,LBRYCLS,0),U)=$P(LDATA(1),U)
28 S FLG=$S(LDA'="":$P(^LBRY(680.5,LDA,0),U,2),TAF'="":$P(^LBRY(680.5,TAF,0),U,2),1:"")
29 ; Move the data from the transaction into the Title Authority File
30 S TX="0;5^0;6^3;5^3;8^3;1^3;3^3;4",FX="1;4^2;1^2;2^3;1^3;3^4;2^4;3"
31 F I=1:1:7 S FR=$P(FX,U,I),TO=$P(TX,U,I) D
32 . S ND1=$P(FR,";"),PC1=$P(FR,";",2),ND2=$P(TO,";"),PC2=$P(TO,";",2)
33 . S $P(^LBRY(680.5,LBRYCLS,ND2),U,PC2)=$P($G(^LBRY(682.1,TRN,ND1)),U,PC1)
34 S PF="2;3-680.5^3;2-680.5^4;1-680.1^4;4-680.2^4;5-680.9",PT="3;6^3;7^3;2^0;4^0;3"
35 F I=1:1:5 S FR=$P(PF,U,I),TO=$P(PT,U,I) D
36 . S PO=$P(FR,"-"),GLB=$P(FR,"-",2)
37 . S ND1=$P(PO,";"),PC1=$P(PO,";",2),ND2=$P(TO,";"),PC2=$P(TO,";",2)
38 . S CH=$P($G(^LBRY(682.1,TRN,ND1)),U,PC1),CHD=CH
39 . I CH'="" S J="" F S J=$O(^LBRY(GLB,"B",$E(CH,1,30),J)) Q:J'>0 S:$P($G(^LBRY(GLB,J,0)),U)=CH CHD=J
40 . S $P(^LBRY(680.5,LBRYCLS,ND2),U,PC2)=CHD
41 I $D(^LBRY(682.1,TRN,6)) S IN=0 F S IN=$O(^LBRY(682.1,TRN,6,IN)) Q:IN'>0 D
42 . S INP=^LBRY(682.1,TRN,6,IN,0)
43 . S ^LBRY(680.5,LBRYCLS,1,IN,0)=$S($D(^LBRY(680.8,"B",INP)):$O(^LBRY(680.8,"B",INP,"")),1:INP)
44 . S ^LBRY(680.5,LBRYCLS,1,0)="^680.53PA^"_IN_U_IN
45CK I TYP="TIR",('$D(^LBRY(682.1,TRN,7))) D
46 . S DA=LBRYCLS,DIE="^LBRY(680.5,",DR="4///@"
47 . D ^DIE
48 I $D(^LBRY(682.1,TRN,7)) S IN=0 F S IN=$O(^LBRY(682.1,TRN,7,IN)) Q:IN'>0 D
49 . S ^LBRY(680.5,LBRYCLS,2,IN,0)=^LBRY(682.1,TRN,7,IN,0)
50 . S ^LBRY(680.5,LBRYCLS,2,0)="^680.54^"_IN_U_IN_U_DT
51 S $P(^LBRY(680.5,LBRYCLS,0),U,5)="N",$P(^(0),U,2)=FLG
52 I $F("CTI,TIC,LTR",TYP) S DA=LDA,DIK="^LBRY(680.5," D ^DIK
53 S DA=LBRYCLS D ^LBRYX53
54 I LDA'="" S LBRTDA="" D
55 . F S LBRTDA=$O(^LBRY(680,"B",LDA,LBRTDA)) Q:LBRTDA="" D
56 . . S DR=".01///^S X=TAF",DIC="^LBRY(680,",DIE=DIC,DA=LBRTDA D ^DIE
57 Q
58EXIT K CHD,FX,TX,ND1,PC1,ND2,PC2,FR,TO,PF,PT,PO,GLB,IN,INP,DR,DIE,DIC,DA
59 K D,D0,X,LBRYCLS,LDATA,LDA,TAF,TRN,QFL,FLG,BFL
60 S $P(^LBRY(680.5,0),U,3)=99000
61 Q
Note: See TracBrowser for help on using the repository browser.