| 1 | LBRYPRCS ;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=""
|
|---|
| 6 | TR 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
|
|---|
| 16 | TR1 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
|
|---|
| 20 | TI ; 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
|
|---|
| 45 | CK 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
|
|---|
| 58 | EXIT 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
|
|---|
