DGGECSR ;ALB/MJK,RMO - Read Processor Routine ; 24 AUG 89 11:00am
;;5.3;Registration;;Aug 13, 1993
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGGECSR 1264 printed Dec 13, 2024@02:43:39 Page 2
DGGECSR ;ALB/MJK,RMO - Read Processor Routine ; 24 AUG 89 11:00am
+1 ;;5.3;Registration;;Aug 13, 1993
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
