- DDGF2 ;SFISC/MKO - ACTIONS FOR SELECTED FIELDS ;1FEB2017
- ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;GFT;**1055,1057**
- ;
- ;Input:
- ; B = internal block number
- ; F = internal field order
- ; T = type of element ("C" = caption, "D" = data)
- ; C = caption
- ; C1 = $Y of caption
- ; C2 = $X of caption
- ; D = data representation (underlines)
- ; D1 = $Y of data
- ; D2 = $X of data
- ; L = length of data
- ; P1 = page $Y
- ; P2 = page $X
- ; DDGFWID = "P1" or such
- N DDGFE
- S DDGFE=0,DDGFLSV=DDGFLIM
- S DDGFLIM=$P(@DDGFREF@("F",DDGFPG,B),U,1,2)_U_$P(DDGFLIM,U,3,4)
- ;
- D PAINTS
- S DDGFE=0 F S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE ;MOVE THE FIELD AROUND UNTIL SPACEBAR DESELECTS IT.
- D END
- D:$G(DDGFSUBP) SUBPG1^DDGFPG
- Q
- ;
- END ;Redraw field 'F' on block 'B'
- S DDGFLIM=DDGFLSV K DDGFLSV
- Q:$D(^DIST(.404,B,40,F,0))[0
- N OLD,NEW,CAP,DATA S (NEW,OLD)=$G(^(2)),CAP=$P(NEW,U,3),DATA=$P(NEW,U,1)
- ;^DIST(.404,D0,40,D1,2)= (#4.1) DATA COORDINATE [1F] ^ (#4.2) DATA LENGTH [2N] ^ (#5.1) CAPTION COORDINATE [3F] ^ (#5.2) SUPPRESS COLON AFTER CAPTION? [4S]
- S $P(NEW,U,2)=$G(L) ;LENGTH WILL NOT BE THERE, IF THIS IS A CAPTION
- S $P(CAP,",",1)=C1+1,$P(CAP,",",2)=C2+1
- S C3=C2+$L(C)-1 ;CAPTION END POINT
- I T="C",C]"" D
- . D WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2)
- . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
- ;
- I $D(D) D
- . S $P(DATA,",",1)=D1+1,$P(DATA,",",2)=D2+1
- . S D3=D2+L-1 ;DATA END POINT
- . D WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
- . S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
- ;
- S @DDGFREF@("F",DDGFPG,B,F)=C1_U_C2_U_C3_U_C_U_$S($D(D):D1_U_D2_U_D3_U_L,1:"^^^")_U_1,DDGFCHG=1
- D KILLPGS^DDGFFLDA(B,DDGFWID) ;BLOCK MAY BE ON ANOTHER PAGE
- ;
- X IOXY
- Q
- ;
- TO ;Time-out
- W $C(7)
- G DESELECT
- ;
- DESELECT ;SPACE-BAR HAS DESELECTED FIELD
- S DDGFE=1
- Q
- ;
- LNU I T="C" Q:C1'>$P(DDGFLIM,U) ;LINE FEED UP
- I $D(D),D1'>$P(DDGFLIM,U) Q
- D REDRAW S:T="C" C1=C1-1
- S:$D(D) D1=D1-1
- S DY=DY-1
- D PAINTS
- Q
- LND I T="C" Q:C1'<$P(DDGFLIM,U,3) ;LINE FEED DOWN
- I $D(D),D1'<$P(DDGFLIM,U,3) Q
- D REDRAW
- S:T="C" C1=C1+1
- S:$D(D) D1=D1+1
- S DY=DY+1
- D PAINTS
- Q
- CHR I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
- I $D(D),D2+L>$P(DDGFLIM,U,4) Q
- D REDRAW S:T="C" C2=C2+1
- S:$D(D) D2=D2+1
- S DX=DX+1
- D PAINTS
- Q
- CHL I T="C" Q:C2'>$P(DDGFLIM,U,2)
- I $D(D),D2'>$P(DDGFLIM,U,2) Q
- D REDRAW S:T="C" C2=C2-1
- S:$D(D) D2=D2-1
- S DX=DX-1
- D PAINTS
- Q
- TBR N X
- I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
- I $D(D),D2+L>$P(DDGFLIM,U,4) Q
- D REDRAW
- I T="C" D
- . S X=$$MIN(5,$P(DDGFLIM,U,4)-(C2+$L(C)),$S($D(D):$P(DDGFLIM,U,4)-(D2+L)+1,1:""))
- . S C2=C2+X
- E S X=$$MIN(5,$P(DDGFLIM,U,4)-(D2+L)+1)
- S:$D(D) D2=D2+X
- S DX=DX+X
- D PAINTS
- Q
- TBL N X
- I T="C" Q:C2'>$P(DDGFLIM,U,2)
- I $D(D),D2'>$P(DDGFLIM,U,2) Q
- D REDRAW
- I T="C" D
- . S X=$$MIN(5,C2-$P(DDGFLIM,U,2),$S($D(D):D2-$P(DDGFLIM,U,2),1:""))
- . S C2=C2-X
- E S X=$$MIN(5,D2-$P(DDGFLIM,U,2))
- S:$D(D) D2=D2-X
- S DX=DX-X
- D PAINTS
- Q
- SCT N Y
- I T="C" Q:C1'>$P(DDGFLIM,U)
- I $D(D),D1'>$P(DDGFLIM,U) Q
- D REDRAW
- I T="C" S Y=$S('$D(D):C1,C1<D1:C1,1:D1)-$P(DDGFLIM,U),C1=C1-Y
- E S Y=D1-$P(DDGFLIM,U)
- S:$D(D) D1=D1-Y
- S DY=DY-Y
- D PAINTS
- Q
- SCB N Y
- I T="C" Q:C1'<$P(DDGFLIM,U,3)
- I $D(D),D1'<$P(DDGFLIM,U,3) Q
- D REDRAW
- I T="C" S Y=$P(DDGFLIM,U,3)-$S('$D(D):C1,C1>D1:C1,1:D1),C1=C1+Y
- E S Y=$P(DDGFLIM,U,3)-D1
- S:$D(D) D1=D1+Y
- S DY=DY+Y
- D PAINTS
- Q
- SCR N X
- I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
- I $D(D),D2+L>$P(DDGFLIM,U,4) Q
- D REDRAW
- I T="C" D
- . S X=$P(DDGFLIM,U,4)-$S('$D(D):C2+$L(C),C2+$L(C)>(D2+L):C2+$L(C),1:D2+L)+1
- . S C2=C2+X
- E S X=$P(DDGFLIM,U,4)-(D2+L)+1
- S:$D(D) D2=D2+X
- S DX=DX+X
- D PAINTS
- Q
- SCL N X
- I T="C" Q:C2'>$P(DDGFLIM,U,2)
- I $D(D),D2'>$P(DDGFLIM,U,2) Q
- D REDRAW
- I T="C" S X=$S('$D(D):C2,C2<D2:C2,1:D2)-$P(DDGFLIM,U,2),C2=C2-X
- E S X=D2-$P(DDGFLIM,U,2)
- S:$D(D) D2=D2-X
- S DX=DX-X
- D PAINTS
- Q
- EDIT ;A SEPARATE SCREENMAN FORM WILL EDIT THIS SINGLE FIELD
- G EDIT^DDGFFLD
- SUBPG ;
- G SUBPG^DDGFPG
- ;
- RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
- N DDGFS
- I DDGFR D
- . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
- . X IOXY W DDGFS_$J("",7-$L(DDGFS))
- S DY=DDGFY,DX=DDGFX X IOXY
- Q
- ;
- REDRAW ;
- D:T="C" REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C2-P2)_U_1_U_$L(C))
- D:$D(D) REPAINT^DDGLIBW(DDGFWID,(D1-P1)_U_(D2-P2)_U_1_U_L)
- Q
- ;
- PAINTS ;
- N Y,X
- S Y=DY,X=DX
- I T="C" S DY=C1,DX=C2 X IOXY W $P(DDGLVID,DDGLDEL,6)_$E(C,1,$$MIN($L(C),$P(DDGFLIM,U,4)-C2+1))_$P(DDGLVID,DDGLDEL,10)
- I $D(D) S DY=D1,DX=D2 X IOXY W $P(DDGLVID,DDGLDEL,6)_$E(D,1,$$MIN(L,$P(DDGFLIM,U,4)-D2+1))_$P(DDGLVID,DDGLDEL,10)
- D RC(Y,X)
- Q
- ;
- MIN(X,Y,Z) ;Return the minimum of two or three numbers
- N A
- S A=$S(X<Y:X,1:Y)
- Q:$G(Z)="" A
- Q $S(A<Z:A,1:Z)
- ;
- READ() N S,Y
- F R *Y:DTIME D C Q:Y'=-1
- Q Y
- ;
- C I Y<0 S Y="TO" Q
- S S=""
- C1 S S=S_$C(Y)
- I DDGF("SIN")'[(U_S) D I Y=-1 W $C(7) Q
- . I $C(Y)'?1L S Y=-1 Q
- . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
- ;
- I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
- R *Y:5 G:Y'=-1 C1 W $C(7)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGF2 5421 printed Jan 18, 2025@03:43:12 Page 2
- DDGF2 ;SFISC/MKO - ACTIONS FOR SELECTED FIELDS ;1FEB2017
- +1 ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;GFT;**1055,1057**
- +7 ;
- +8 ;Input:
- +9 ; B = internal block number
- +10 ; F = internal field order
- +11 ; T = type of element ("C" = caption, "D" = data)
- +12 ; C = caption
- +13 ; C1 = $Y of caption
- +14 ; C2 = $X of caption
- +15 ; D = data representation (underlines)
- +16 ; D1 = $Y of data
- +17 ; D2 = $X of data
- +18 ; L = length of data
- +19 ; P1 = page $Y
- +20 ; P2 = page $X
- +21 ; DDGFWID = "P1" or such
- +22 NEW DDGFE
- +23 SET DDGFE=0
- SET DDGFLSV=DDGFLIM
- +24 SET DDGFLIM=$PIECE(@DDGFREF@("F",DDGFPG,B),U,1,2)_U_$PIECE(DDGFLIM,U,3,4)
- +25 ;
- +26 DO PAINTS
- +27 ;MOVE THE FIELD AROUND UNTIL SPACEBAR DESELECTS IT.
- SET DDGFE=0
- FOR
- SET Y=$$READ
- if $TEXT(@Y)=""
- WRITE $CHAR(7)
- if $TEXT(@Y)]""
- DO @Y
- if DDGFE
- QUIT
- +28 DO END
- +29 if $GET(DDGFSUBP)
- DO SUBPG1^DDGFPG
- +30 QUIT
- +31 ;
- END ;Redraw field 'F' on block 'B'
- +1 SET DDGFLIM=DDGFLSV
- KILL DDGFLSV
- +2 if $DATA(^DIST(.404,B,40,F,0))[0
- QUIT
- +3 NEW OLD,NEW,CAP,DATA
- SET (NEW,OLD)=$GET(^(2))
- SET CAP=$PIECE(NEW,U,3)
- SET DATA=$PIECE(NEW,U,1)
- +4 ;^DIST(.404,D0,40,D1,2)= (#4.1) DATA COORDINATE [1F] ^ (#4.2) DATA LENGTH [2N] ^ (#5.1) CAPTION COORDINATE [3F] ^ (#5.2) SUPPRESS COLON AFTER CAPTION? [4S]
- +5 ;LENGTH WILL NOT BE THERE, IF THIS IS A CAPTION
- SET $PIECE(NEW,U,2)=$GET(L)
- +6 SET $PIECE(CAP,",",1)=C1+1
- SET $PIECE(CAP,",",2)=C2+1
- +7 ;CAPTION END POINT
- SET C3=C2+$LENGTH(C)-1
- +8 IF T="C"
- IF C]""
- Begin DoDot:1
- +9 DO WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2)
- +10 SET @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
- End DoDot:1
- +11 ;
- +12 IF $DATA(D)
- Begin DoDot:1
- +13 SET $PIECE(DATA,",",1)=D1+1
- SET $PIECE(DATA,",",2)=D2+1
- +14 ;DATA END POINT
- SET D3=D2+L-1
- +15 DO WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
- +16 SET @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
- End DoDot:1
- +17 ;
- +18 SET @DDGFREF@("F",DDGFPG,B,F)=C1_U_C2_U_C3_U_C_U_$SELECT($DATA(D):D1_U_D2_U_D3_U_L,1:"^^^")_U_1
- SET DDGFCHG=1
- +19 ;BLOCK MAY BE ON ANOTHER PAGE
- DO KILLPGS^DDGFFLDA(B,DDGFWID)
- +20 ;
- +21 XECUTE IOXY
- +22 QUIT
- +23 ;
- TO ;Time-out
- +1 WRITE $CHAR(7)
- +2 GOTO DESELECT
- +3 ;
- DESELECT ;SPACE-BAR HAS DESELECTED FIELD
- +1 SET DDGFE=1
- +2 QUIT
- +3 ;
- LNU ;LINE FEED UP
- IF T="C"
- if C1'>$PIECE(DDGFLIM,U)
- QUIT
- +1 IF $DATA(D)
- IF D1'>$PIECE(DDGFLIM,U)
- QUIT
- +2 DO REDRAW
- if T="C"
- SET C1=C1-1
- +3 if $DATA(D)
- SET D1=D1-1
- +4 SET DY=DY-1
- +5 DO PAINTS
- +6 QUIT
- LND ;LINE FEED DOWN
- IF T="C"
- if C1'<$PIECE(DDGFLIM,U,3)
- QUIT
- +1 IF $DATA(D)
- IF D1'<$PIECE(DDGFLIM,U,3)
- QUIT
- +2 DO REDRAW
- +3 if T="C"
- SET C1=C1+1
- +4 if $DATA(D)
- SET D1=D1+1
- +5 SET DY=DY+1
- +6 DO PAINTS
- +7 QUIT
- CHR IF T="C"
- if C2+$LENGTH(C)>$PIECE(DDGFLIM,U,4)
- QUIT
- +1 IF $DATA(D)
- IF D2+L>$PIECE(DDGFLIM,U,4)
- QUIT
- +2 DO REDRAW
- if T="C"
- SET C2=C2+1
- +3 if $DATA(D)
- SET D2=D2+1
- +4 SET DX=DX+1
- +5 DO PAINTS
- +6 QUIT
- CHL IF T="C"
- if C2'>$PIECE(DDGFLIM,U,2)
- QUIT
- +1 IF $DATA(D)
- IF D2'>$PIECE(DDGFLIM,U,2)
- QUIT
- +2 DO REDRAW
- if T="C"
- SET C2=C2-1
- +3 if $DATA(D)
- SET D2=D2-1
- +4 SET DX=DX-1
- +5 DO PAINTS
- +6 QUIT
- TBR NEW X
- +1 IF T="C"
- if C2+$LENGTH(C)>$PIECE(DDGFLIM,U,4)
- QUIT
- +2 IF $DATA(D)
- IF D2+L>$PIECE(DDGFLIM,U,4)
- QUIT
- +3 DO REDRAW
- +4 IF T="C"
- Begin DoDot:1
- +5 SET X=$$MIN(5,$PIECE(DDGFLIM,U,4)-(C2+$LENGTH(C)),$SELECT($DATA(D):$PIECE(DDGFLIM,U,4)-(D2+L)+1,1:""))
- +6 SET C2=C2+X
- End DoDot:1
- +7 IF '$TEST
- SET X=$$MIN(5,$PIECE(DDGFLIM,U,4)-(D2+L)+1)
- +8 if $DATA(D)
- SET D2=D2+X
- +9 SET DX=DX+X
- +10 DO PAINTS
- +11 QUIT
- TBL NEW X
- +1 IF T="C"
- if C2'>$PIECE(DDGFLIM,U,2)
- QUIT
- +2 IF $DATA(D)
- IF D2'>$PIECE(DDGFLIM,U,2)
- QUIT
- +3 DO REDRAW
- +4 IF T="C"
- Begin DoDot:1
- +5 SET X=$$MIN(5,C2-$PIECE(DDGFLIM,U,2),$SELECT($DATA(D):D2-$PIECE(DDGFLIM,U,2),1:""))
- +6 SET C2=C2-X
- End DoDot:1
- +7 IF '$TEST
- SET X=$$MIN(5,D2-$PIECE(DDGFLIM,U,2))
- +8 if $DATA(D)
- SET D2=D2-X
- +9 SET DX=DX-X
- +10 DO PAINTS
- +11 QUIT
- SCT NEW Y
- +1 IF T="C"
- if C1'>$PIECE(DDGFLIM,U)
- QUIT
- +2 IF $DATA(D)
- IF D1'>$PIECE(DDGFLIM,U)
- QUIT
- +3 DO REDRAW
- +4 IF T="C"
- SET Y=$SELECT('$DATA(D):C1,C1<D1:C1,1:D1)-$PIECE(DDGFLIM,U)
- SET C1=C1-Y
- +5 IF '$TEST
- SET Y=D1-$PIECE(DDGFLIM,U)
- +6 if $DATA(D)
- SET D1=D1-Y
- +7 SET DY=DY-Y
- +8 DO PAINTS
- +9 QUIT
- SCB NEW Y
- +1 IF T="C"
- if C1'<$PIECE(DDGFLIM,U,3)
- QUIT
- +2 IF $DATA(D)
- IF D1'<$PIECE(DDGFLIM,U,3)
- QUIT
- +3 DO REDRAW
- +4 IF T="C"
- SET Y=$PIECE(DDGFLIM,U,3)-$SELECT('$DATA(D):C1,C1>D1:C1,1:D1)
- SET C1=C1+Y
- +5 IF '$TEST
- SET Y=$PIECE(DDGFLIM,U,3)-D1
- +6 if $DATA(D)
- SET D1=D1+Y
- +7 SET DY=DY+Y
- +8 DO PAINTS
- +9 QUIT
- SCR NEW X
- +1 IF T="C"
- if C2+$LENGTH(C)>$PIECE(DDGFLIM,U,4)
- QUIT
- +2 IF $DATA(D)
- IF D2+L>$PIECE(DDGFLIM,U,4)
- QUIT
- +3 DO REDRAW
- +4 IF T="C"
- Begin DoDot:1
- +5 SET X=$PIECE(DDGFLIM,U,4)-$SELECT('$DATA(D):C2+$LENGTH(C),C2+$LENGTH(C)>(D2+L):C2+$LENGTH(C),1:D2+L)+1
- +6 SET C2=C2+X
- End DoDot:1
- +7 IF '$TEST
- SET X=$PIECE(DDGFLIM,U,4)-(D2+L)+1
- +8 if $DATA(D)
- SET D2=D2+X
- +9 SET DX=DX+X
- +10 DO PAINTS
- +11 QUIT
- SCL NEW X
- +1 IF T="C"
- if C2'>$PIECE(DDGFLIM,U,2)
- QUIT
- +2 IF $DATA(D)
- IF D2'>$PIECE(DDGFLIM,U,2)
- QUIT
- +3 DO REDRAW
- +4 IF T="C"
- SET X=$SELECT('$DATA(D):C2,C2<D2:C2,1:D2)-$PIECE(DDGFLIM,U,2)
- SET C2=C2-X
- +5 IF '$TEST
- SET X=D2-$PIECE(DDGFLIM,U,2)
- +6 if $DATA(D)
- SET D2=D2-X
- +7 SET DX=DX-X
- +8 DO PAINTS
- +9 QUIT
- EDIT ;A SEPARATE SCREENMAN FORM WILL EDIT THIS SINGLE FIELD
- +1 GOTO EDIT^DDGFFLD
- SUBPG ;
- +1 GOTO SUBPG^DDGFPG
- +2 ;
- RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
- +1 NEW DDGFS
- +2 IF DDGFR
- Begin DoDot:1
- +3 SET DY=IOSL-6
- SET DX=IOM-9
- SET DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
- +4 XECUTE IOXY
- WRITE DDGFS_$JUSTIFY("",7-$LENGTH(DDGFS))
- End DoDot:1
- +5 SET DY=DDGFY
- SET DX=DDGFX
- XECUTE IOXY
- +6 QUIT
- +7 ;
- REDRAW ;
- +1 if T="C"
- DO REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C2-P2)_U_1_U_$LENGTH(C))
- +2 if $DATA(D)
- DO REPAINT^DDGLIBW(DDGFWID,(D1-P1)_U_(D2-P2)_U_1_U_L)
- +3 QUIT
- +4 ;
- PAINTS ;
- +1 NEW Y,X
- +2 SET Y=DY
- SET X=DX
- +3 IF T="C"
- SET DY=C1
- SET DX=C2
- XECUTE IOXY
- WRITE $PIECE(DDGLVID,DDGLDEL,6)_$EXTRACT(C,1,$$MIN($LENGTH(C),$PIECE(DDGFLIM,U,4)-C2+1))_$PIECE(DDGLVID,DDGLDEL,10)
- +4 IF $DATA(D)
- SET DY=D1
- SET DX=D2
- XECUTE IOXY
- WRITE $PIECE(DDGLVID,DDGLDEL,6)_$EXTRACT(D,1,$$MIN(L,$PIECE(DDGFLIM,U,4)-D2+1))_$PIECE(DDGLVID,DDGLDEL,10)
- +5 DO RC(Y,X)
- +6 QUIT
- +7 ;
- MIN(X,Y,Z) ;Return the minimum of two or three numbers
- +1 NEW A
- +2 SET A=$SELECT(X<Y:X,1:Y)
- +3 if $GET(Z)=""
- QUIT A
- +4 QUIT $SELECT(A<Z:A,1:Z)
- +5 ;
- READ() NEW S,Y
- +1 FOR
- READ *Y:DTIME
- DO C
- if Y'=-1
- QUIT
- +2 QUIT Y
- +3 ;
- C IF Y<0
- SET Y="TO"
- QUIT
- +1 SET S=""
- C1 SET S=S_$CHAR(Y)
- +1 IF DDGF("SIN")'[(U_S)
- Begin DoDot:1
- +2 IF $CHAR(Y)'?1L
- SET Y=-1
- QUIT
- +3 SET S=$EXTRACT(S,1,$LENGTH(S)-1)_$CHAR(Y-32)
- if DDGF("SIN")'[(U_S_U)
- SET Y=-1
- End DoDot:1
- IF Y=-1
- WRITE $CHAR(7)
- QUIT
- +4 ;
- +5 IF DDGF("SIN")[(U_S_U)
- IF S'=$CHAR(27)
- SET Y=$PIECE(DDGF("SOUT"),U,$LENGTH($PIECE(DDGF("SIN"),U_S_U),U))
- QUIT
- +6 READ *Y:5
- if Y'=-1
- GOTO C1
- WRITE $CHAR(7)
- +7 QUIT