LBRYRTX ;ISC2/DJM-ROUTINES USED IN FILE 682 ;[ 07/06/00  2:18 PM ]
 ;;2.5;Library;**2,8**;Mar 11, 1996
 K LBRYPTR Q
I ;ENTERED FROM JOURNAL DATE SET STATEMENT OF X-REF AD
 Q:($G(DIC)'[682)
 I $D(^LBRY(682,DA,1))#2,$P(^(1),U,6)]"" Q
 S LDFX=$P(^LBRY(682,DA,0),U,2),LBRYX=X
COPY ;MOVE COPIES FROM FILE 681 INTO FILE 682 AT THE COPY OF ISSUE
 ;MULTIPLE AND SET ROUTING STATUS TO 4 OR 5.
 S (COPY,TOTAL,CO682)=0
 F  S COPY=$O(^LBRY(681,"AC",LDFX,COPY)) G:COPY="" EXIT S COPY1=0 D COPY1
COPY1 S COPY1=$O(^LBRY(681,"AC",LDFX,COPY,COPY1)) Q:COPY1=""
 S COPY2=^LBRY(681,COPY1,1),START=$P(COPY2,U,10),STOP=$P(COPY2,U,11)
 I START="",STOP="" D TRANS G COPY1
 I START]"",STOP="",START-X<1 D TRANS G COPY1
 I START="",STOP]"",STOP-X'<0 D TRANS G COPY1
 I START]"",STOP]"" I START-X<1&(STOP-X'<0) D TRANS G COPY1
 G COPY1
TRANS S TOTAL=TOTAL+1,CO682=CO682+1,COPYNO=$E($P(COPY2,U),1,30)
 S ^LBRY(682,DA,4,TOTAL,0)=COPYNO_"^4^"_COPY1,^LBRY(682,DA,4,"B",COPYNO,TOTAL)=""
 I COPYNO="ToC" S $P(^LBRY(682,DA,4,TOTAL,0),U,2)=5,CO682=CO682-1 S:CO682<0 CO682=0
 Q
EXIT I TOTAL>0 S ENTRY=$P(^DD(682,4,0),U,2),^LBRY(682,DA,4,0)="^"_ENTRY_"^"_TOTAL_"^"_TOTAL
 S $P(^LBRY(682,DA,1),U,6)=DUZ S:CO682=0 CO682="" S $P(^LBRY(682,DA,1),U,5)=CO682
EXIT1 K COPY,COPY1,COPY2,COPYNO,ENTRY,LBX,LDFX,START,STOP,TOC,TOC1,TOTAL,XX1,XXZ
 Q
NOCS ;ISSUE ROUTING STATUS SET OF X-REF AD IN MULTIPLE 682.04,1
 ;
 ;  Q:'$D(LBRYPTR) exists to prevent the setting of the field
 ;  when executing Reindex from FileMan.
 Q:'$D(LBRYPTR)
 ;
 ;  Q:$G(LBRYINT)=1 exists to prevent the setting of the field
 ;  when integrating sites.
 Q:$G(LBRYINT)=1
 ;
 I $P(^LBRY(682,DA(1),4,DA,0),U)'="ToC" S XXZ=^LBRY(682,DA(1),1),XX1=$P(XXZ,U,4) I X<4 S XX1=XX1+1,$P(^LBRY(682,DA(1),1),U,4)=XX1 G DAS
 I $P(^LBRY(682,DA(1),4,DA,0),U)'="ToC" I XX1="" S TOC=$O(^LBRY(682,DA(1),4,"B","ToC",0)) D:TOC'="" TOCRMV
 G DAS
NOCD ;ISSUE ROUTING STATUS KILL OF X-REF AD IN MULTIPLE 682.04,1
 ;
 ;  Q:'$D(LBRYPTR) exists to prevent the subtracting of the field
 ;  when executing Reindex from FileMan.
 Q:'$D(LBRYPTR)
 ;
 ;  Q:$G(LBRYINT)=1 exists to prevent the subtracting of the field
 ;  when integrating sites.
 Q:$G(LBRYINT)=1
 ;
 I $P(^LBRY(682,DA(1),4,DA,0),U)'="ToC" I X<4 S XXZ=^LBRY(682,DA(1),1),XX1=$P(XXZ,U,4),XX1=XX1-1 S:XX1<1 XX1="" S $P(XXZ,U,4)=XX1 S:XX1="" $P(XXZ,U,7)="" S ^LBRY(682,DA(1),1)=XXZ
 G DAK
TOCRMV S TOC1=^LBRY(682,DA(1),4,TOC,0),$P(TOC1,U,2)=5,TOC1=$P(TOC1,U,1,3)
 S ^LBRY(682,DA(1),4,TOC,0)=TOC1 K ^LBRY(682,"A2",DA(1),TOC)
 Q
DAS I X<4 S $P(^LBRY(682,DA(1),4,DA,0),U,8)=DUZ,LBX=X D
 . S LDATE=$P(^LBRY(682,DA(1),4,DA,0),U,7) S:LDATE="" LDATE=DT
 G EXIT1
DAK S XX=$P(^LBRY(682,DA(1),4,DA,0),U,7),$P(^(0),U,7)="",$P(^(0),U,8)="",$P(^(0),U,6)=""
 I XX]""&($P($G(^LBRY(682,DA(1),0)),U,2)'="") K ^LBRY(682,"A4",XX,$P(^LBRY(682,DA(1),0),U,2),DA(1),DA)
 G EXIT1
CNO ;INPUT TRANSFORM FROM 689.04 FIELD .02
 Q
 I $P(^LBRY(682,DA(1),0),U,2)=$P(^(0),U,2) D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
 Q
A4 ;SET/KILL FOR "A4" CROSS-REFERENCE FOR CHANGE IN .02 FIELD
 N LBRCOPN,LBRDA1
 S LBRCOPN=0
A4LP1 S LBRCOPN=$O(^LBRY(682,DA,4,"B",LBRCOPN)) Q:LBRCOPN=""
 S LBRDA1=0
A4LP2 S LBRDA1=$O(^LBRY(682,DA,4,"B",LBRCOPN,LBRDA1)) G A4LP1:LBRDA1=""
 I LBRTYPE="SET",$P($G(^LBRY(682,DA,4,LBRDA1,0)),U,7)'="" S ^LBRY(682,"A4",$P(^LBRY(682,DA,4,LBRDA1,0),U,7),$E(X,1,30),DA,LBRDA1)=""
 I LBRTYPE="KILL",$P($G(^LBRY(682,DA,4,LBRDA1,0)),U,7)'="" K ^LBRY(682,"A4",$P(^LBRY(682,DA,4,LBRDA1,0),U,7),$E(X,1,30),DA,LBRDA1)
 G A4LP2