| [613] | 1 | LBRYCSE0 ;ISC2/DJM-COPY SPECIFIC EDITING ;[ 06/03/97  4:16 PM ]
 | 
|---|
 | 2 |  ;;2.5;Library;**2**;Mar 11, 1996
 | 
|---|
 | 3 | START F I=1:1:3 S LS(I)=""
 | 
|---|
 | 4 |  I $D(A(1)) S LS(1)=", (E)dit, (R)emove"
 | 
|---|
 | 5 |  S:$D(A(E0-1)) LS(2)=", (B)ackup"
 | 
|---|
 | 6 |  S:$D(A(E1+1)) LS(3)=", (F)orward"
 | 
|---|
 | 7 |  S LINE="Choose: (I)nsert"_LS(1)_LS(2)_LS(3)_"."
 | 
|---|
 | 8 |  W !!,LINE,"  Exit// "
 | 
|---|
 | 9 | ASK S DTOUT=0 R X:DTIME E  W $C(7) S DTOUT=1 G ^LBRYCSE
 | 
|---|
 | 10 |  I X="" G ^LBRYCSE
 | 
|---|
 | 11 |  I X=" " S:$D(^TMP("LBRY",DUZ,7)) X=^(7)
 | 
|---|
 | 12 |  I X="??" S XQH="LBRY CSE CHOICE PROMPT" D EN^XQH G CONT^LBRYCSE
 | 
|---|
 | 13 |  I X="^" G ^LBRYCSE
 | 
|---|
 | 14 |  I $L(X)=2,"Bb"[$E(X,1),"?"[$E(X,2) D  G PAS
 | 
|---|
 | 15 |  . W !,"You may BACKUP to any 'ID NUM' before the lowest one on the screen."
 | 
|---|
 | 16 |  I $L(X)=2,"Ff"[$E(X,1),"?"[$E(X,2) D  G PAS
 | 
|---|
 | 17 |  . W !,"You may go FORWARD to any 'ID NUM' including the lowest one on the screen."
 | 
|---|
 | 18 |  I $D(A(E0-1)),"Bb"[$E(X,1) D UTIL,BACKUP^LBRYCK0 G CONT^LBRYCSE
 | 
|---|
 | 19 |  I $D(A(E1+1)),"Ff"[$E(X,1) D UTIL,FORWARD^LBRYCK0 G CONT^LBRYCSE
 | 
|---|
 | 20 |  I "Rr"[$E(X,1) D UTIL S X=$E(X,2,999) D REMOVE^LBRYCSE G:$G(DTOUT) KILL D CON^LBRYCSE S LBUDT=1 G CONT^LBRYCSE
 | 
|---|
 | 21 |  I "Ee"[$E(X,1) D UTIL S X=$E(X,2,999) D QUERY^LBRYCSE G:'$D(YDT) KILL G CONT^LBRYCSE
 | 
|---|
 | 22 |  I "Ii"[$E(X,1),$L(X)>1,$E(X,2)'="?" D  G PAS
 | 
|---|
 | 23 |  . W !,"You may only add a '?' to an 'I' choice."
 | 
|---|
 | 24 |  I "Ii"[$E(X,1) D UTIL S X=$E(X,2) D ENTER^LBRYCSE G:'$D(YDT) KILL D CON^LBRYCSE G CONT^LBRYCSE
 | 
|---|
 | 25 |  W !!,"You can select I, E, R, B or F if they are in the above prompt."
 | 
|---|
 | 26 |  W !,"You may enter a '?' after any choice for help.  Enter '??' for more help."
 | 
|---|
 | 27 | PAS S XZ="Continue// " D PAUSE^LBRYUTL K XZ
 | 
|---|
 | 28 |  G CONT^LBRYCSE
 | 
|---|
 | 29 | UTIL K ^TMP("LBRY",DUZ,7) S ^(7)=X Q
 | 
|---|
 | 30 | UDT NEW I S (COPY,TOTAL,CO681)=0,LBCLS=D0
 | 
|---|
 | 31 |  F  S COPY=$O(^LBRY(681,"AC",LBCLS,COPY)) Q:COPY'>0  D
 | 
|---|
 | 32 |  . S COPY1=0 F  S COPY1=$O(^LBRY(681,"AC",LBCLS,COPY,COPY1)) Q:COPY1'>0  D
 | 
|---|
 | 33 |  . . S COPY2=$G(^LBRY(681,COPY1,1)),START=$P(COPY2,U,10),STOP=$P(COPY2,U,11)
 | 
|---|
 | 34 |  . . I START="",STOP="" S CO681=CO681+1 Q
 | 
|---|
 | 35 |  . . I START]"",STOP="",START-DT<1 S CO681=CO681+1 Q
 | 
|---|
 | 36 |  . . I START="",STOP]"",STOP-DT'<0 S CO681=CO681+1 Q
 | 
|---|
 | 37 |  . . I START]"",STOP]"",START-DT<1,STOP-DT'<0 S CO681=CO681+1
 | 
|---|
 | 38 | FINI S:($G(CO681))=0 CO681="" S X=CO681
 | 
|---|
 | 39 | KILL K COPY,COPY1,COPY2,I,LS,LBCLS,LBUDT,LINE,TOTAL,XQH,START,STOP,CO681
 | 
|---|
 | 40 |  Q
 | 
|---|