DDW2 ;SFISC/MKO-SETTINGS, MODES ;11:32 AM 25 Aug 2000 [ 04/02/2003 8:25 AM ]
;;22.0;VA FileMan;**1001**;APR 1, 2003
;;22.0;VA FileMan;**18**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
TSET N DDWX
S DDWX=$E(DDWRUL,DDWC)
S DDWX=$S(DDWX="T":"=",DDWX="=":"T",1:DDWX)
S $E(DDWRUL,DDWC)=DDWX
I DDWC'=DDWLMAR,DDWC'=DDWRMAR D
. D CUP(DDWMR+1,DDWC-DDWOFS) W DDWX
. D POS(DDWRW,DDWC)
Q
;
TSALL ;Prompt for tab stops
N DDWHLP,DDWANS,DDWCOD
S DDWHLP(1)=" Specify in which column(s) you want to set tab stops. To set individual"
S DDWHLP(2)=" tab stops, type a series of numbers separated by commas, for example:"
S DDWHLP(3)=" 4,7,15,20. To set tab stops at repeated intervals after the last stop,"
S DDWHLP(4)=" or column 1, type the interval as +n, for example: 10,20,+5."
D ASK^DDWG(5,"Columns in which to set tab stops: ",30,$G(DDWTAB),"D TSALLVAL^DDW2",.DDWHLP,.DDWANS,.DDWCOD)
;
Q:DDWCOD="TO"!(DDWANS=U)!(DDWANS=DDWTAB)
S DDWTAB=DDWANS
S DDWRUL=$$RULER(DDWTAB)
D RULER^DDW3,POS(DDWRW,DDWC)
Q
;
TSALLVAL ;Validate tab stops
K DDWERR
S:DDWX="@" DDWX=""
I DDWX?1."^"!($P($G(DDWCOD),U)="TO") S DDWX=U Q
I $TR(DDWX,"+,")?.E1.APC.E D
. S DDWERR=" Response can contain only commas (,), plus signs (+), and numbers."
Q
;
RULER(TAB) ;Return the ruler with tab stops
N C,INT,LAST,POS,RUL
S RUL=$TR($J("",255)," ","=")
;
;Process each comma piece in tab
S LAST=1
F C=1:1:$L(TAB,",") D
. S POS=$P(TAB,",",C) Q:POS'?.1"+"1.3N
. I $E(POS)="+" D
.. S INT=+$E(POS,2,999)
.. F POS=LAST+INT:INT:255 S $E(RUL,POS)="T"
. E S:POS<256 $E(RUL,POS)="T",LAST=POS
Q RUL
;
LSET I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
I DDWC>231 D ERR("Left margin cannot be set beyond column 231") Q
I DDWC'<DDWRMAR D ERR("Left margin must be left of right margin") Q
I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
. D CUP(DDWMR+1,DDWLMAR-DDWOFS) W $E(DDWRUL,DDWLMAR)
D CUP(DDWMR+1,DDWC-DDWOFS) W "<" D POS(DDWRW,DDWC)
S DDWLMAR=DDWC
Q
;
RSET I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
I DDWC>245 D ERR("Right margin cannot be set beyond column 245") Q
I DDWC'>DDWLMAR D ERR("Right margin must be right of left margin") Q
I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
. D CUP(DDWMR+1,DDWRMAR-DDWOFS) W $E(DDWRUL,DDWRMAR)
D CUP(DDWMR+1,DDWC-DDWOFS) W ">" D POS(DDWRW,DDWC)
S DDWRMAR=DDWC
Q
;
WRAPM S DDWRAP=DDWRAP+1#2
D CUP(0,3) W $S(DDWRAP:"[ WRAP ]",1:"========")
I 'DDWRAP D
. S DDWLMAR(1)=DDWLMAR,DDWLMAR=1
. S DDWRMAR(1)=DDWRMAR,DDWRMAR=245
E D
. S DDWLMAR=DDWLMAR(1) K DDWLMAR(1)
. S DDWRMAR=DDWRMAR(1) K DDWRMAR(1)
D RULER^DDW3,POS(DDWRW,DDWC)
Q
;
REPLM S DDWREP=DDWREP+1#2
D CUP(0,13) W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
D POS(DDWRW,DDWC)
Q
;
STAT S DDWSTAT=DDWSTAT+1#2
I DDWSTAT S DDWTO=1
E D
. D CUP(DDWMR+2,1)
. W $P(DDGLCLR,DDGLDEL) D POS(DDWRW,DDWC)
. S DDWTO=DTIME
. K DDWTC
Q
;
CUP(Y,X) ;Cursor positioning
S DY=IOTM+Y-2,DX=X-1 X IOXY
Q
;
POS(R,C,F) ;Pos cursor based on char pos C
N DDWX
S:$G(C)="E" C=$L($G(DDWL(R)))+1
S:$G(F)["N" DDWN=$G(DDWL(R))
S:$G(F)["R" DDWRW=R,DDWC=C
;
S DDWX=C-DDWOFS
I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
Q
;
SCR(C) ;Return screen number
Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
;
ERR(DDWX) ;Error
W $C(7)
D MSG^DDW(DDWX) H 2 D MSG^DDW()
F R *DDWX:0 E Q
D POS(DDWRW,DDWC)
Q
DDW2 ;SFISC/MKO-SETTINGS, MODES ;11:32 AM 25 Aug 2000 [ 04/02/2003 8:25 AM ]
+1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
+2 ;;22.0;VA FileMan;**18**;Mar 30, 1999
+3 ;Per VHA Directive 10-93-142, this routine should not be modified.
+4 ;
TSET NEW DDWX
+1 SET DDWX=$EXTRACT(DDWRUL,DDWC)
+2 SET DDWX=$SELECT(DDWX="T":"=",DDWX="=":"T",1:DDWX)
+3 SET $EXTRACT(DDWRUL,DDWC)=DDWX
+4 IF DDWC'=DDWLMAR
IF DDWC'=DDWRMAR
Begin DoDot:1
+5 DO CUP(DDWMR+1,DDWC-DDWOFS)
WRITE DDWX
+6 DO POS(DDWRW,DDWC)
End DoDot:1
+7 QUIT
+8 ;
TSALL ;Prompt for tab stops
+1 NEW DDWHLP,DDWANS,DDWCOD
+2 SET DDWHLP(1)=" Specify in which column(s) you want to set tab stops. To set individual"
+3 SET DDWHLP(2)=" tab stops, type a series of numbers separated by commas, for example:"
+4 SET DDWHLP(3)=" 4,7,15,20. To set tab stops at repeated intervals after the last stop,"
+5 SET DDWHLP(4)=" or column 1, type the interval as +n, for example: 10,20,+5."
+6 DO ASK^DDWG(5,"Columns in which to set tab stops: ",30,$GET(DDWTAB),"D TSALLVAL^DDW2",.DDWHLP,.DDWANS,.DDWCOD)
+7 ;
+8 IF DDWCOD="TO"!(DDWANS=U)!(DDWANS=DDWTAB)
QUIT
+9 SET DDWTAB=DDWANS
+10 SET DDWRUL=$$RULER(DDWTAB)
+11 DO RULER^DDW3
DO POS(DDWRW,DDWC)
+12 QUIT
+13 ;
TSALLVAL ;Validate tab stops
+1 KILL DDWERR
+2 IF DDWX="@"
SET DDWX=""
+3 IF DDWX?1."^"!($PIECE($GET(DDWCOD),U)="TO")
SET DDWX=U
QUIT
+4 IF $TRANSLATE(DDWX,"+,")?.E1.APC.E
Begin DoDot:1
+5 SET DDWERR=" Response can contain only commas (,), plus signs (+), and numbers."
End DoDot:1
+6 QUIT
+7 ;
RULER(TAB) ;Return the ruler with tab stops
+1 NEW C,INT,LAST,POS,RUL
+2 SET RUL=$TRANSLATE($JUSTIFY("",255)," ","=")
+3 ;
+4 ;Process each comma piece in tab
+5 SET LAST=1
+6 FOR C=1:1:$LENGTH(TAB,",")
Begin DoDot:1
+7 SET POS=$PIECE(TAB,",",C)
IF POS'?.1"+"1.3N
QUIT
+8 IF $EXTRACT(POS)="+"
Begin DoDot:2
+9 SET INT=+$EXTRACT(POS,2,999)
+10 FOR POS=LAST+INT:INT:255
SET $EXTRACT(RUL,POS)="T"
End DoDot:2
+11 IF '$TEST
IF POS<256
SET $EXTRACT(RUL,POS)="T"
SET LAST=POS
End DoDot:1
+12 QUIT RUL
+13 ;
LSET IF 'DDWRAP
DO ERR("Margins cannot be set when wrap is off")
QUIT
+1 IF DDWC>231
DO ERR("Left margin cannot be set beyond column 231")
QUIT
+2 IF DDWC'<DDWRMAR
DO ERR("Left margin must be left of right margin")
QUIT
+3 IF DDWLMAR-DDWOFS'<1
IF DDWLMAR-DDWOFS'>IOM
Begin DoDot:1
+4 DO CUP(DDWMR+1,DDWLMAR-DDWOFS)
WRITE $EXTRACT(DDWRUL,DDWLMAR)
End DoDot:1
+5 DO CUP(DDWMR+1,DDWC-DDWOFS)
WRITE "<"
DO POS(DDWRW,DDWC)
+6 SET DDWLMAR=DDWC
+7 QUIT
+8 ;
RSET IF 'DDWRAP
DO ERR("Margins cannot be set when wrap is off")
QUIT
+1 IF DDWC>245
DO ERR("Right margin cannot be set beyond column 245")
QUIT
+2 IF DDWC'>DDWLMAR
DO ERR("Right margin must be right of left margin")
QUIT
+3 IF DDWRMAR-DDWOFS'<1
IF DDWRMAR-DDWOFS'>IOM
Begin DoDot:1
+4 DO CUP(DDWMR+1,DDWRMAR-DDWOFS)
WRITE $EXTRACT(DDWRUL,DDWRMAR)
End DoDot:1
+5 DO CUP(DDWMR+1,DDWC-DDWOFS)
WRITE ">"
DO POS(DDWRW,DDWC)
+6 SET DDWRMAR=DDWC
+7 QUIT
+8 ;
WRAPM SET DDWRAP=DDWRAP+1#2
+1 DO CUP(0,3)
WRITE $SELECT(DDWRAP:"[ WRAP ]",1:"========")
+2 IF 'DDWRAP
Begin DoDot:1
+3 SET DDWLMAR(1)=DDWLMAR
SET DDWLMAR=1
+4 SET DDWRMAR(1)=DDWRMAR
SET DDWRMAR=245
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET DDWLMAR=DDWLMAR(1)
KILL DDWLMAR(1)
+7 SET DDWRMAR=DDWRMAR(1)
KILL DDWRMAR(1)
End DoDot:1
+8 DO RULER^DDW3
DO POS(DDWRW,DDWC)
+9 QUIT
+10 ;
REPLM SET DDWREP=DDWREP+1#2
+1 DO CUP(0,13)
WRITE $SELECT(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
+2 DO POS(DDWRW,DDWC)
+3 QUIT
+4 ;
STAT SET DDWSTAT=DDWSTAT+1#2
+1 IF DDWSTAT
SET DDWTO=1
+2 IF '$TEST
Begin DoDot:1
+3 DO CUP(DDWMR+2,1)
+4 WRITE $PIECE(DDGLCLR,DDGLDEL)
DO POS(DDWRW,DDWC)
+5 SET DDWTO=DTIME
+6 KILL DDWTC
End DoDot:1
+7 QUIT
+8 ;
CUP(Y,X) ;Cursor positioning
+1 SET DY=IOTM+Y-2
SET DX=X-1
XECUTE IOXY
+2 QUIT
+3 ;
POS(R,C,F) ;Pos cursor based on char pos C
+1 NEW DDWX
+2 IF $GET(C)="E"
SET C=$LENGTH($GET(DDWL(R)))+1
+3 IF $GET(F)["N"
SET DDWN=$GET(DDWL(R))
+4 IF $GET(F)["R"
SET DDWRW=R
SET DDWC=C
+5 ;
+6 SET DDWX=C-DDWOFS
+7 IF DDWX>IOM!(DDWX<1)
DO SHIFT^DDW3(C,.DDWOFS)
+8 SET DY=IOTM+R-2
SET DX=C-DDWOFS-1
XECUTE IOXY
+9 QUIT
+10 ;
SCR(C) ;Return screen number
+1 QUIT C-$PIECE(DDWOFS,U,2)-1\$PIECE(DDWOFS,U,3)+1
+2 ;
ERR(DDWX) ;Error
+1 WRITE $CHAR(7)
+2 DO MSG^DDW(DDWX)
HANG 2
DO MSG^DDW()
+3 FOR
READ *DDWX:0
IF '$TEST
QUIT
+4 DO POS(DDWRW,DDWC)
+5 QUIT
