Last change
on this file since 1661 was 613, checked in by George Lilly, 15 years ago |
initial load of WorldVistAEHR
|
File size:
635 bytes
|
Line | |
---|
1 | LBRYPG0 ;ISC2/DJM-SERIALS PURGE OPTION ;[ 05/23/97 12:13 PM ]
|
---|
2 | ;;2.5;Library;**2**;Mar 11, 1996
|
---|
3 | CHECK ;
|
---|
4 | FORWARD S E=0 G:$L(X)>1 FWD S:$D(A(E1+1)) (E0,E1)=E1+1 G FWD1
|
---|
5 | FWD S X1=+$E(X,2,99) Q:X1'>0!'($D(A(X1))) Q:$E(X,1)="B"&(X1'<E0) Q:$E(X,1)="F"&(X1'>E0) S E0=$S($D(A(X1)):X1,$D(A(E1+1)):E1+1,1:E0) S:X1>0&($D(A(X1))) E1=X1
|
---|
6 | FWD1 F I=1:1:4 Q:'$D(A(E1+1)) S E1=E1+1
|
---|
7 | Q
|
---|
8 | BACKUP S E=0 G:$L(X)>1 FWD I $D(A(E0-5)) S (E0,E1)=E0-5 G FWD1
|
---|
9 | BACKUP1 F I=1:1:5 Q:'$D(A(E0-1)) S E0=E0-1
|
---|
10 | S E1=E0 G FWD1
|
---|
11 | ALL K ALL S CNT=$P($G(^LBRY(680,LBRYLOC,7)),U),(QTY,IT)=0
|
---|
12 | F S IT=$O(^LBRY(681,"AC",LBRYLOC,IT)) Q:IT="" S QTY=QTY+1
|
---|
13 | I QTY<CNT S ALL=1
|
---|
14 | Q
|
---|
Note:
See
TracBrowser
for help on using the repository browser.