DGGECSR.m

DGGECSR ;ALB/MJK,RMO - Read Processor Routine ; 24 AUG 89 11:00am

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

SET S:'$D(DGRD(0)) DGRD(0)="" W:DGRD(0)'["S" !?2,"Choose one of the following:"

 F I=0:0 S I=$O(DGRD(I)) Q:'I  W:DGRD(0)'["S" !?10,$P(DGRD(I),"^",1) S V=$P(DGRD(I),"^",1) D UPPER S $P(DGRD(I),"^",3)=S

READ K S,I,J,L,I W !!,$S($D(DGRD("A")):DGRD("A"),1:"Enter Response: ")

 I $D(DGRD("B")),$D(DGRD(DGRD("B"))) W $P(DGRD(DGRD("B")),"^",1),"// "

 R X:$S($D(DGRD("DTIME")):+DGRD("DTIME"),1:DTIME) S X1=X G HELP:X="?" S DTOUT='$T,L=$L(X) I X["^" S X="^" G Q

 I DTOUT S X=$S('$D(DGRD("DTOUT")):"^",'$D(DGRD(+DGRD("DTOUT"))):"^",1:$P(DGRD(+DGRD("DTOUT")),"^")) G Q

 I 'L S X=$S('$D(DGRD("B")):"",'$D(DGRD(+DGRD("B"))):"",1:$P(DGRD(+DGRD("B")),"^")) G Q

 S V=X D UPPER

 F I=0:0 S I=$O(DGRD(I)) Q:'I  I S=$E($P(DGRD(I),"^",3),1,L) S X=$P(DGRD(I),"^",1) W $E(X,L+1,99) G Q

 W *7

HELP ;

 I $D(DGRD("XQH")) S XQH=DGRD("XQH") D EN^XQH W ! G SET

 W !!?2,"Enter one of the following:"

 F I=0:0 S I=$O(DGRD(I)) Q:'I  W !?5,"'",$P(DGRD(I),"^",1),"'",?25,"to ",$E($P(DGRD(I),"^",2),1,79-$X)

 W !?5,"^",?25,"to stop." G READ

 ;

Q K DTOUT,S,C,I,L Q

 ;

UPPER ;

 S S="" F J=1:1 S C=$E($P(V,"^",1),J) Q:C=""  S:$A(C)>96&($A(C)<123) C=$C($A(C)-32) S S=S_C

 K C,V Q

DGGECSR   ;ALB/MJK,RMO - Read Processor Routine ; 24 AUG 89 11:00am

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

SET        IF '$DATA(DGRD(0))

               SET DGRD(0)=""

           IF DGRD(0)'["S"

               WRITE !?2,"Choose one of the following:"

 +1        FOR I=0:0

               SET I=$ORDER(DGRD(I))

               IF 'I

                   QUIT 

               IF DGRD(0)'["S"

                   WRITE !?10,$PIECE(DGRD(I),"^",1)

               SET V=$PIECE(DGRD(I),"^",1)

               DO UPPER

               SET $PIECE(DGRD(I),"^",3)=S

READ       KILL S,I,J,L,I

           WRITE !!,$SELECT($DATA(DGRD("A")):DGRD("A"),1:"Enter Response: ")

 +1        IF $DATA(DGRD("B"))

               IF $DATA(DGRD(DGRD("B")))

                   WRITE $PIECE(DGRD(DGRD("B")),"^",1),"// "

 +2        READ X:$SELECT($DATA(DGRD("DTIME")):+DGRD("DTIME"),1:DTIME)

           SET X1=X

           IF X="?"

               GOTO HELP

           SET DTOUT='$TEST

           SET L=$LENGTH(X)

           IF X["^"

               SET X="^"

               GOTO Q

 +3        IF DTOUT

               SET X=$SELECT('$DATA(DGRD("DTOUT")):"^",'$DATA(DGRD(+DGRD("DTOUT"))):"^",1:$PIECE(DGRD(+DGRD("DTOUT")),"^"))

               GOTO Q

 +4        IF 'L

               SET X=$SELECT('$DATA(DGRD("B")):"",'$DATA(DGRD(+DGRD("B"))):"",1:$PIECE(DGRD(+DGRD("B")),"^"))

               GOTO Q

 +5        SET V=X

           DO UPPER

 +6        FOR I=0:0

               SET I=$ORDER(DGRD(I))

               IF 'I

                   QUIT 

               IF S=$EXTRACT($PIECE(DGRD(I),"^",3),1,L)

                   SET X=$PIECE(DGRD(I),"^",1)

                   WRITE $EXTRACT(X,L+1,99)

                   GOTO Q

 +7        WRITE *7

HELP      ;

 +1        IF $DATA(DGRD("XQH"))

               SET XQH=DGRD("XQH")

               DO EN^XQH

               WRITE !

               GOTO SET

 +2        WRITE !!?2,"Enter one of the following:"

 +3        FOR I=0:0

               SET I=$ORDER(DGRD(I))

               IF 'I

                   QUIT 

               WRITE !?5,"'",$PIECE(DGRD(I),"^",1),"'",?25,"to ",$EXTRACT($PIECE(DGRD(I),"^",2),1,79-$X)

 +4        WRITE !?5,"^",?25,"to stop."

           GOTO READ

 +5       ;

Q          KILL DTOUT,S,C,I,L

           QUIT 

 +1       ;

UPPER     ;

 +1        SET S=""

           FOR J=1:1

               SET C=$EXTRACT($PIECE(V,"^",1),J)

               IF C=""

                   QUIT 

               IF $ASCII(C)>96&($ASCII(C)<123)

                   SET C=$CHAR($ASCII(C)-32)

               SET S=S_C

 +2        KILL C,V

           QUIT