- 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 Feb 19, 2025@00:09:42 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
