DDW ;SFISC/PD KELTZ-SCREEN EDITOR MAIN ROUTINE ;24MAR2006
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;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.
;
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) ;DDWRW=ROW #
N DWHD,DWLC,DDWEDIT,DDWRWSET
S DDWEDIT=1,DDWRWSET=1 ;WE MEAN IT
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 K DIERR
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
MAR I IOBM-IOTM<3 D BLD^DIALOG(202,$$EZBLD^DIALOG(831)) G ERR ;**'TOP & BOTTOM'
;
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
K DIERR 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDW 3489 printed Dec 13, 2024@02:43:51 Page 2
DDW ;SFISC/PD KELTZ-SCREEN EDITOR MAIN ROUTINE ;24MAR2006
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+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 ;
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) ;DDWRW=ROW #
+1 NEW DWHD,DWLC,DDWEDIT,DDWRWSET
+2 ;WE MEAN IT
SET DDWEDIT=1
SET DDWRWSET=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
KILL DIERR
+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
MAR ;**'TOP & BOTTOM'
IF IOBM-IOTM<3
DO BLD^DIALOG(202,$$EZBLD^DIALOG(831))
GOTO ERR
+1 ;
+2 if '$GET(DDWLMAR)
SET DDWLMAR=1
if '$GET(DDWRMAR)
SET DDWRMAR=74
+3 IF DDWRMAR'>DDWLMAR!(DDWLMAR>231)!(DDWRMAR>245)
DO BLD^DIALOG(202,"Left and/or Right Margin")
GOTO ERR
+4 ;
+5 if $DATA(DDW("IN"))[0
DO GETKEY^DDWK
+6 ;
+7 DO CLR
+8 if $PIECE(DDGLED,DDGLDEL,2)]""
WRITE @$PIECE(DDGLED,DDGLDEL,2)
+9 XECUTE DDGLZOSF("EOFF")
XECUTE DDGLZOSF("TRMON")
+10 ;
+11 KILL DDWL,^TMP("DDW",$JOB),^TMP("DDW1",$JOB)
+12 SET (DDWA,DDWSTB,DDWSTAT)=0
SET DDWBF="0010"
+13 ;
+14 SET DDWREP=$GET(DDWFLAGS)["R"
+15 SET DDWRAP=$GET(DDWFLAGS)'["M"
+16 IF 'DDWRAP
Begin DoDot:1
+17 SET DDWLMAR(1)=DDWLMAR
SET DDWLMAR=1
+18 SET DDWRMAR(1)=DDWRMAR
SET DDWRMAR=245
End DoDot:1
+19 ;
+20 IF '$GET(DDWRW)
IF $GET(DDWRW)'="B"
SET DDWRW=1
+21 IF '$GET(DDWC)
IF $GET(DDWC)'="E"
SET DDWC=1
+22 ;
+23 SET DDWTO=DTIME
+24 SET DDWOFS="0^20^^1"
SET $PIECE(DDWOFS,U,3)=IOM-$PIECE(DDWOFS,U,2)
+25 SET DDWMR=IOBM-IOTM+1
+26 ;
+27 if $GET(DDWTAB)=""
SET DDWTAB="+8"
+28 SET DDWRUL=$$RULER^DDW2(DDWTAB)
+29 ;
+30 IF $GET(DDWAUTO)
Begin DoDot:1
+31 NEW DDWX,DDWERR
+32 SET (DDWAUTO,DDWX)=$EXTRACT(DDWAUTO,1,15)
+33 DO AUTOVAL^DDW1
+34 IF $DATA(DDWERR)#2!($GET(DDWAUTO)'>0)
KILL DDWAUTO
QUIT
+35 SET DDWAUTO("H")=$HOROLOG
+36 SET DDWAUTO("S")=DDWAUTO*60
End DoDot:1
+37 IF '$TEST
KILL DDWAUTO
+38 QUIT
+39 ;
RESET ;Reset terminal and cleanup
+1 KILL DIERR
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
