| 1 | LBRYPPR0 ;ISC2/DJM-PREDICTION PATTERN ROUTINE ;[ 06/03/97 5:11 PM ]
|
|---|
| 2 | ;;2.5;Library;**2**;Mar 11, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | VI G:LBNM<1 IC S LBY=$P(LBRYPP2,U,4),LBX=+$E(LBJDT,4,5)
|
|---|
| 5 | D FIND^LBRYPPR G:LBZ<1 IC
|
|---|
| 6 | S LBVOL=$S($D(LBVOL):LBVOL,1:$P(LBJD,U,2)),VOL=$P(LBRYPP2,U)
|
|---|
| 7 | G:$E(VOL)="+" VI1
|
|---|
| 8 | S LBVOL=$S($P(LBRYPP0,U,2)'["NOVOL":VOL,1:"") G VI2
|
|---|
| 9 | VI1 S LBVOL=LBVOL+$E(VOL,2,5)
|
|---|
| 10 | VI2 S LBISS=$S($D(LBISS):LBISS,1:$P(LBJD,U,3)),ISS=$P(LBRYPP2,U,2)
|
|---|
| 11 | G:$E(ISS)="+" VI3 S LBISS=ISS G COPY
|
|---|
| 12 | VI3 S LBISS=LBISS+$E(ISS,2,5) G COPY
|
|---|
| 13 | IC S LBVOL=$S($D(LBVOL):LBVOL,1:$P(LBJD,U,2))
|
|---|
| 14 | S LBISS=$S($D(LBISS):LBISS,1:$P(LBJD,U,3)),ISS=$P(LBRYPP2,U,3)
|
|---|
| 15 | G:$E(ISS)="+" IC1 S LBISS=ISS G COPY
|
|---|
| 16 | IC1 S LBISS=LBISS+$E(ISS,2,5)
|
|---|
| 17 | COPY S (COPY,CO681)=0
|
|---|
| 18 | F G:CO681>0 FINI S COPY=$O(^LBRY(681,"AC",LBRYLOC,COPY)) G:COPY'>0 BEGIN^LBRYPPR S COPY1=0 D COPY1
|
|---|
| 19 | COPY1 Q:CO681>0 S COPY1=$O(^LBRY(681,"AC",LBRYLOC,COPY,COPY1)) Q:COPY1'>0 S COPY2=^LBRY(681,COPY1,1),START=$P(COPY2,U,10),STOP=$P(COPY2,U,11) I START="",STOP="" S CO681=CO681+1 G COPY1
|
|---|
| 20 | I START]"",STOP="",START-DT<1 S CO681=CO681+1 G COPY1
|
|---|
| 21 | I START="",STOP]"",STOP-DT'<0 S CO681=CO681+1 G COPY1
|
|---|
| 22 | I START]"",STOP]"",START-DT<1,STOP-DT'<0 S CO681=CO681+1
|
|---|
| 23 | G COPY1
|
|---|
| 24 | FINI I $D(^LBRY(682,"AC",LBRYLOC,LBJDT)) G EXT
|
|---|
| 25 | S LBNUM=$P(^LBRY(682,0),U,3) F S LBNUM=LBNUM+1 Q:'$D(^LBRY(682,LBNUM,0))
|
|---|
| 26 | K DO S X=LBNUM,DIC="^LBRY(682,",DIC(0)="LN",DLAYGO=682 D FILE^DICN K DLAYGO
|
|---|
| 27 | S DIE=DIC,DA=+Y,DR="[LBRY PREDICT INSERT]" D ^DIE
|
|---|
| 28 | EXT K LBJDT,LBVOL,LBISS,START,STOP,VOL,ISS,COPY,COPY1,COPY2,CO681,LBX,LBY
|
|---|
| 29 | K LBZ,LBRYPP,LBNM,LBA1,LBJD,LBNM,LBRYPP0,LBRYPP1,LBRYPP3,LBRYPP2,LBJDY
|
|---|
| 30 | K EMY,LBRYEF1,LBXA,PUD,X1,X2,XZ,LBJDM,LBJDD,LBMOZ,EM,LBEM,YY,LBWKZ
|
|---|
| 31 | K NEWWK,NXTWK,FM,WOMLBXA,LBXB,LBY1,LBYA,LBYB,DIC,DIE,DR,LBN
|
|---|
| 32 | K LBNUM,LBRYX,WOM,LBRDOW
|
|---|
| 33 | Q
|
|---|
