DDW ;SFISC/PD KELTZ-SCREEN EDITOR MAIN ROUTINE ;11:15 AM 25 Aug 2000 [ 04/02/2003 8:25 AM ]
;;22.0;VA FileMan;**1001**;APR 1, 2003
;;22.0;VA FileMan;**8,18**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
MAIN N DX,DY,IOTM,IOBM
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
;
D INIT I $G(DDWERR) K DDWERR Q
D ^DDWT1,END
Q
;
EDIT(DIC,DDWFLAGS,DIWETXT,DIWESUB,DDWRW,DDWC,DDWTM,DDWBM,DDWLMAR,DDWRMAR,DDWAUTO,DDWTAB) ;
N DWHD,DWLC,DDWEDIT
S DDWEDIT=1
G MAIN
;
MSG(DDWX) ;Write message
S DY=$G(DDWBM,IOSL)-1,DX=0 X IOXY
W $P(DDGLCLR,DDGLDEL)_$G(DDWX)
I $G(DDWX)="",$D(DDWMARK) D IND^DDW7(1)
Q
;
INIT ;Setup, initialize variables
N X,DDWI
D INIT^DDGLIB0() G:$G(DIERR) ERR
I $P(DDGLED,DDGLDEL,2)_$P(DDGLED,DDGLDEL,3)_$P(DDGLED,DDGLDEL,4)="" D TRMERR^DDGLIB0("Set Top and Bottom Margins, Delete Line, and Insert Line") G ERR
;
G:'$D(DIC) FERR
S DDWDIC=$$CREF^DILF(DIC)
S X="S X="_DDWDIC D ^DIM G:'$D(X) FERR
G:'$D(@DDWDIC) FERR
S DDWDIC=$NA(@DDWDIC)
S DIC=$$OREF^DILF(DDWDIC)
;
I IOSL>100 S DDWIOSL=IOSL,IOSL=24
S IOTM=$G(DDWTM,1)+2,IOBM=$G(DDWBM,IOSL)-3
I IOBM-IOTM<3 D BLD^DIALOG(202,"Top and/or Bottom Margin") G ERR
;
S:'$G(DDWLMAR) DDWLMAR=1 S:'$G(DDWRMAR) DDWRMAR=74
I DDWRMAR'>DDWLMAR!(DDWLMAR>231)!(DDWRMAR>245) D BLD^DIALOG(202,"Left and/or Right Margin") G ERR
;
D:$D(DDW("IN"))[0 GETKEY^DDWK
;
D CLR
W:$P(DDGLED,DDGLDEL,2)]"" @$P(DDGLED,DDGLDEL,2)
X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
;
K DDWL,^TMP("DDW",$J),^TMP("DDW1",$J)
S (DDWA,DDWSTB,DDWSTAT)=0,DDWBF="0010"
;
S DDWREP=$G(DDWFLAGS)["R"
S DDWRAP=$G(DDWFLAGS)'["M"
I 'DDWRAP D
. S DDWLMAR(1)=DDWLMAR,DDWLMAR=1
. S DDWRMAR(1)=DDWRMAR,DDWRMAR=245
;
I '$G(DDWRW),$G(DDWRW)'="B" S DDWRW=1
I '$G(DDWC),$G(DDWC)'="E" S DDWC=1
;
S DDWTO=DTIME
S DDWOFS="0^20^^1",$P(DDWOFS,U,3)=IOM-$P(DDWOFS,U,2)
S DDWMR=IOBM-IOTM+1
;
S:$G(DDWTAB)="" DDWTAB="+8"
S DDWRUL=$$RULER^DDW2(DDWTAB)
;
I $G(DDWAUTO) D
. N DDWX,DDWERR
. S (DDWAUTO,DDWX)=$E(DDWAUTO,1,15)
. D AUTOVAL^DDW1
. I $D(DDWERR)#2!($G(DDWAUTO)'>0) K DDWAUTO Q
. S DDWAUTO("H")=$H
. S DDWAUTO("S")=DDWAUTO*60
E K DDWAUTO
Q
;
RESET ;Reset terminal and cleanup
D INIT^DDGLIB0() D:$G(DIERR) MSG^DIALOG("BW")
W $P($G(DDGLVID),DDGLDEL,10)
;
END ;Cleanup
S:$D(DDWIOSL)#2 IOSL=DDWIOSL
I $P(DDGLED,DDGLDEL,2)]"" D
. S IOTM=1,IOBM=$S($D(IOSL)#2:IOSL,1:24) W @$P(DDGLED,DDGLDEL,2)
D CLR
;
K DDW,DDWA,DDWBF,DDWC,DDWCHG,DDWCNT,DDWDIC,DDWED,DDWFIN,DDWFIND,DDWHLOG
K DDWIOSL,DDWL,DDWMARK,DDWMR,DDWN,DDWOFS,DDWQ,DDWRAP,DDWREP
K DDWRUL,DDWRW,DDWSTAT,DDWSTB,DDWTC,DDWTO
K ^TMP("DDW",$J),^TMP("DDW1",$J),^TMP("DDWH",$J)
I $$ROUEXIST^DILIBF("XPDUTL"),$$VERSION^XPDUTL("XU")>7.1
E K ^TMP("DDWB",$J)
;
;D:'$D(DIWE) X^DIWE
I $D(DDS) D
. D:$D(DIWESW) KILL^DDGLIB0("K")
E D KILL^DDGLIB0($G(DDWFLAGS))
Q
;
CLR ;Clear screen
I $G(DDWTM,1)=1,$G(DDWBM,IOSL)=IOSL W $P(DDGLCLR,DDGLDEL,2)
E D
. S DX=0
. F DY=$G(DDWTM,1)-1:1:$G(DDWBM,IOSL)-1 X IOXY W $P(DDGLCLR,DDGLDEL)
Q
;
FERR ;File input parameter error
D BLD^DIALOG(202,"File")
D ERR
Q
;
ERR ;Error during setup
W $C(7),! D MSG^DIALOG("BW") W !
D KILL^DDGLIB0()
S DDWERR=1
Q
DDW ;SFISC/PD KELTZ-SCREEN EDITOR MAIN ROUTINE ;11:15 AM 25 Aug 2000 [ 04/02/2003 8:25 AM ]
+1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
+2 ;;22.0;VA FileMan;**8,18**;Mar 30, 1999
+3 ;Per VHA Directive 10-93-142, this routine should not be modified.
MAIN NEW DX,DY,IOTM,IOBM
+1 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+2 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
DO INIZE^DIEFU
+3 ;
+4 DO INIT
IF $GET(DDWERR)
KILL DDWERR
QUIT
+5 DO ^DDWT1
DO END
+6 QUIT
+7 ;
EDIT(DIC,DDWFLAGS,DIWETXT,DIWESUB,DDWRW,DDWC,DDWTM,DDWBM,DDWLMAR,DDWRMAR,DDWAUTO,DDWTAB) ;
+1 NEW DWHD,DWLC,DDWEDIT
+2 SET DDWEDIT=1
+3 GOTO MAIN
+4 ;
MSG(DDWX) ;Write message
+1 SET DY=$GET(DDWBM,IOSL)-1
SET DX=0
XECUTE IOXY
+2 WRITE $PIECE(DDGLCLR,DDGLDEL)_$GET(DDWX)
+3 IF $GET(DDWX)=""
IF $DATA(DDWMARK)
DO IND^DDW7(1)
+4 QUIT
+5 ;
INIT ;Setup, initialize variables
+1 NEW X,DDWI
+2 DO INIT^DDGLIB0()
IF $GET(DIERR)
GOTO ERR
+3 IF $PIECE(DDGLED,DDGLDEL,2)_$PIECE(DDGLED,DDGLDEL,3)_$PIECE(DDGLED,DDGLDEL,4)=""
DO TRMERR^DDGLIB0("Set Top and Bottom Margins, Delete Line, and Insert Line")
GOTO ERR
+4 ;
+5 IF '$DATA(DIC)
GOTO FERR
+6 SET DDWDIC=$$CREF^DILF(DIC)
+7 SET X="S X="_DDWDIC
DO ^DIM
IF '$DATA(X)
GOTO FERR
+8 IF '$DATA(@DDWDIC)
GOTO FERR
+9 SET DDWDIC=$NAME(@DDWDIC)
+10 SET DIC=$$OREF^DILF(DDWDIC)
+11 ;
+12 IF IOSL>100
SET DDWIOSL=IOSL
SET IOSL=24
+13 SET IOTM=$GET(DDWTM,1)+2
SET IOBM=$GET(DDWBM,IOSL)-3
+14 IF IOBM-IOTM<3
DO BLD^DIALOG(202,"Top and/or Bottom Margin")
GOTO ERR
+15 ;
+16 IF '$GET(DDWLMAR)
SET DDWLMAR=1
IF '$GET(DDWRMAR)
SET DDWRMAR=74
+17 IF DDWRMAR'>DDWLMAR!(DDWLMAR>231)!(DDWRMAR>245)
DO BLD^DIALOG(202,"Left and/or Right Margin")
GOTO ERR
+18 ;
+19 IF $DATA(DDW("IN"))[0
DO GETKEY^DDWK
+20 ;
+21 DO CLR
+22 IF $PIECE(DDGLED,DDGLDEL,2)]""
WRITE @$PIECE(DDGLED,DDGLDEL,2)
+23 XECUTE DDGLZOSF("EOFF")
XECUTE DDGLZOSF("TRMON")
+24 ;
+25 KILL DDWL,^TMP("DDW",$JOB),^TMP("DDW1",$JOB)
+26 SET (DDWA,DDWSTB,DDWSTAT)=0
SET DDWBF="0010"
+27 ;
+28 SET DDWREP=$GET(DDWFLAGS)["R"
+29 SET DDWRAP=$GET(DDWFLAGS)'["M"
+30 IF 'DDWRAP
Begin DoDot:1
+31 SET DDWLMAR(1)=DDWLMAR
SET DDWLMAR=1
+32 SET DDWRMAR(1)=DDWRMAR
SET DDWRMAR=245
End DoDot:1
+33 ;
+34 IF '$GET(DDWRW)
IF $GET(DDWRW)'="B"
SET DDWRW=1
+35 IF '$GET(DDWC)
IF $GET(DDWC)'="E"
SET DDWC=1
+36 ;
+37 SET DDWTO=DTIME
+38 SET DDWOFS="0^20^^1"
SET $PIECE(DDWOFS,U,3)=IOM-$PIECE(DDWOFS,U,2)
+39 SET DDWMR=IOBM-IOTM+1
+40 ;
+41 IF $GET(DDWTAB)=""
SET DDWTAB="+8"
+42 SET DDWRUL=$$RULER^DDW2(DDWTAB)
+43 ;
+44 IF $GET(DDWAUTO)
Begin DoDot:1
+45 NEW DDWX,DDWERR
+46 SET (DDWAUTO,DDWX)=$EXTRACT(DDWAUTO,1,15)
+47 DO AUTOVAL^DDW1
+48 IF $DATA(DDWERR)#2!($GET(DDWAUTO)'>0)
KILL DDWAUTO
QUIT
+49 SET DDWAUTO("H")=$HOROLOG
+50 SET DDWAUTO("S")=DDWAUTO*60
End DoDot:1
+51 IF '$TEST
KILL DDWAUTO
+52 QUIT
+53 ;
RESET ;Reset terminal and cleanup
+1 DO INIT^DDGLIB0()
IF $GET(DIERR)
DO MSG^DIALOG("BW")
+2 WRITE $PIECE($GET(DDGLVID),DDGLDEL,10)
+3 ;
END ;Cleanup
+1 IF $DATA(DDWIOSL)#2
SET IOSL=DDWIOSL
+2 IF $PIECE(DDGLED,DDGLDEL,2)]""
Begin DoDot:1
+3 SET IOTM=1
SET IOBM=$SELECT($DATA(IOSL)#2:IOSL,1:24)
WRITE @$PIECE(DDGLED,DDGLDEL,2)
End DoDot:1
+4 DO CLR
+5 ;
+6 KILL DDW,DDWA,DDWBF,DDWC,DDWCHG,DDWCNT,DDWDIC,DDWED,DDWFIN,DDWFIND,DDWHLOG
+7 KILL DDWIOSL,DDWL,DDWMARK,DDWMR,DDWN,DDWOFS,DDWQ,DDWRAP,DDWREP
+8 KILL DDWRUL,DDWRW,DDWSTAT,DDWSTB,DDWTC,DDWTO
+9 KILL ^TMP("DDW",$JOB),^TMP("DDW1",$JOB),^TMP("DDWH",$JOB)
+10 IF $$ROUEXIST^DILIBF("XPDUTL")
IF $$VERSION^XPDUTL("XU")>7.1
+11 IF '$TEST
KILL ^TMP("DDWB",$JOB)
+12 ;
+13 ;D:'$D(DIWE) X^DIWE
+14 IF $DATA(DDS)
Begin DoDot:1
+15 IF $DATA(DIWESW)
DO KILL^DDGLIB0("K")
End DoDot:1
+16 IF '$TEST
DO KILL^DDGLIB0($GET(DDWFLAGS))
+17 QUIT
+18 ;
CLR ;Clear screen
+1 IF $GET(DDWTM,1)=1
IF $GET(DDWBM,IOSL)=IOSL
WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+2 IF '$TEST
Begin DoDot:1
+3 SET DX=0
+4 FOR DY=$GET(DDWTM,1)-1:1:$GET(DDWBM,IOSL)-1
XECUTE IOXY
WRITE $PIECE(DDGLCLR,DDGLDEL)
End DoDot:1
+5 QUIT
+6 ;
FERR ;File input parameter error
+1 DO BLD^DIALOG(202,"File")
+2 DO ERR
+3 QUIT
+4 ;
ERR ;Error during setup
+1 WRITE $CHAR(7),!
DO MSG^DIALOG("BW")
WRITE !
+2 DO KILL^DDGLIB0()
+3 SET DDWERR=1
+4 QUIT
