LBRYPRCS ;SSI/ALA-PROCESS LIBRARY TRANSACTIONS ;[ 02/07/01  1:04 PM ]
 ;;2.5;Library;**2,8,9**;Mar 11, 1996
 ;  This is to automatically process the library transactions
 ;  received from FORUM
 S TRN=""
TR S TRN=$O(^LBRY(682.1,"AC","R",TRN)) G EXIT:TRN=""
 S TYP=$P(^LBRY(682.1,TRN,0),U,2)
 F I=1:1:4 S LDATA(I)=$G(^LBRY(682.1,TRN,I))
 S TAF=$P(LDATA(1),U,2),LDA=$P(LDATA(1),U,3)
 I TYP="DLT" S:$D(^LBRY(680.5,TAF,0)) $P(^(0),U,2)=2 G TR1
 I TYP="PPR"!(TYP="CPR") D PP^LBRYPRC1 G TR1
 I TYP="FRR"!(TYP="CFR") D FR^LBRYPRC1 G TR1
 I TYP="PUR" D PU^LBRYPRC1 G TR1
 I TYP="ISR" D IN^LBRYPRC1 G TR1
 S QFL=0 S:$G(BFL)="" BFL=0 D TI I QFL G TR
TR1 S DIC="^LBRY(682.1,",DIE=DIC,DA=TRN,DR="2///^S X=""P""" D ^DIE
 K CHD,FX,TX,ND1,PC1,ND2,PC2,FR,TO,PF,PT,PO,GLB,IN,INP,DR,DIE,DIC,DA
 K D,D0,X,LBRYCLS,LDATA,LDA,TAF,TYP,QFL,FLG
 G TR
TI ;  Update a title from a transaction
 Q:TAF=""  I LDA'="",$G(^LBRY(680.5,LDA,0))="" Q
 S TIT=$P(LDATA(1),U)
 I $D(^LBRY(680.5,TAF,0)),TIT'[$P(^LBRY(680.5,TAF,0),U) D  S QFL=1 Q
 . S DIC="^LBRY(682.1,",DIE=DIC,DA=TRN,DR="2///^S X=""M""" D ^DIE
 . I BFL=0 S XMB="LBRYMANL",XMY("G.LBRYUPDT")="",XMDUZ="FORUM LIBRARIANS" D ^XMB K XMY,XMDUZ,XMG S BFL=1
 I LDA'="" S DA=LDA D ^LBRYX51
 S LBRYCLS=TAF,$P(^LBRY(680.5,LBRYCLS,0),U)=$P(LDATA(1),U)
 S FLG=$S(LDA'="":$P(^LBRY(680.5,LDA,0),U,2),TAF'="":$P(^LBRY(680.5,TAF,0),U,2),1:"")
 ;  Move the data from the transaction into the Title Authority File
 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"
 F I=1:1:7 S FR=$P(FX,U,I),TO=$P(TX,U,I) D
 . S ND1=$P(FR,";"),PC1=$P(FR,";",2),ND2=$P(TO,";"),PC2=$P(TO,";",2)
 . S $P(^LBRY(680.5,LBRYCLS,ND2),U,PC2)=$P($G(^LBRY(682.1,TRN,ND1)),U,PC1)
 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"
 F I=1:1:5 S FR=$P(PF,U,I),TO=$P(PT,U,I) D
 . S PO=$P(FR,"-"),GLB=$P(FR,"-",2)
 . S ND1=$P(PO,";"),PC1=$P(PO,";",2),ND2=$P(TO,";"),PC2=$P(TO,";",2)
 . S CH=$P($G(^LBRY(682.1,TRN,ND1)),U,PC1),CHD=CH
 . 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
 . S $P(^LBRY(680.5,LBRYCLS,ND2),U,PC2)=CHD
 I $D(^LBRY(682.1,TRN,6)) S IN=0 F  S IN=$O(^LBRY(682.1,TRN,6,IN)) Q:IN'>0  D
 . S INP=^LBRY(682.1,TRN,6,IN,0)
 . S ^LBRY(680.5,LBRYCLS,1,IN,0)=$S($D(^LBRY(680.8,"B",INP)):$O(^LBRY(680.8,"B",INP,"")),1:INP)
 . S ^LBRY(680.5,LBRYCLS,1,0)="^680.53PA^"_IN_U_IN
CK I TYP="TIR",('$D(^LBRY(682.1,TRN,7))) D
 . S DA=LBRYCLS,DIE="^LBRY(680.5,",DR="4///@"
 . D ^DIE
 I $D(^LBRY(682.1,TRN,7)) S IN=0 F  S IN=$O(^LBRY(682.1,TRN,7,IN)) Q:IN'>0  D
 . S ^LBRY(680.5,LBRYCLS,2,IN,0)=^LBRY(682.1,TRN,7,IN,0)
 . S ^LBRY(680.5,LBRYCLS,2,0)="^680.54^"_IN_U_IN_U_DT
 S $P(^LBRY(680.5,LBRYCLS,0),U,5)="N",$P(^(0),U,2)=FLG
 I $F("CTI,TIC,LTR",TYP) S DA=LDA,DIK="^LBRY(680.5," D ^DIK
 S DA=LBRYCLS D ^LBRYX53
 I LDA'="" S LBRTDA="" D
 . F  S LBRTDA=$O(^LBRY(680,"B",LDA,LBRTDA)) Q:LBRTDA=""  D
 . . S DR=".01///^S X=TAF",DIC="^LBRY(680,",DIE=DIC,DA=LBRTDA D ^DIE
 Q
EXIT K CHD,FX,TX,ND1,PC1,ND2,PC2,FR,TO,PF,PT,PO,GLB,IN,INP,DR,DIE,DIC,DA
 K D,D0,X,LBRYCLS,LDATA,LDA,TAF,TRN,QFL,FLG,BFL
 S $P(^LBRY(680.5,0),U,3)=99000
 Q