source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYPPR0.m

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1LBRYPPR0 ;ISC2/DJM-PREDICTION PATTERN ROUTINE ;[ 06/03/97 5:11 PM ]
2 ;;2.5;Library;**2**;Mar 11, 1996
3 ;
4VI 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
9VI1 S LBVOL=LBVOL+$E(VOL,2,5)
10VI2 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
12VI3 S LBISS=LBISS+$E(ISS,2,5) G COPY
13IC 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
16IC1 S LBISS=LBISS+$E(ISS,2,5)
17COPY 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
19COPY1 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
24FINI 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
28EXT 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
Note: See TracBrowser for help on using the repository browser.