source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDW.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.0 KB
RevLine 
[613]1DDW ;SFISC/PD KELTZ-SCREEN EDITOR MAIN ROUTINE ;11:15 AM 25 Aug 2000
2 ;;22.0;VA FileMan;**8,18**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4MAIN N DX,DY,IOTM,IOBM
5 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
6 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
7 ;
8 D INIT I $G(DDWERR) K DDWERR Q
9 D ^DDWT1,END
10 Q
11 ;
12EDIT(DIC,DDWFLAGS,DIWETXT,DIWESUB,DDWRW,DDWC,DDWTM,DDWBM,DDWLMAR,DDWRMAR,DDWAUTO,DDWTAB) ;
13 N DWHD,DWLC,DDWEDIT
14 S DDWEDIT=1
15 G MAIN
16 ;
17MSG(DDWX) ;Write message
18 S DY=$G(DDWBM,IOSL)-1,DX=0 X IOXY
19 W $P(DDGLCLR,DDGLDEL)_$G(DDWX)
20 I $G(DDWX)="",$D(DDWMARK) D IND^DDW7(1)
21 Q
22 ;
23INIT ;Setup, initialize variables
24 N X,DDWI
25 D INIT^DDGLIB0() G:$G(DIERR) ERR
26 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
27 ;
28 G:'$D(DIC) FERR
29 S DDWDIC=$$CREF^DILF(DIC)
30 S X="S X="_DDWDIC D ^DIM G:'$D(X) FERR
31 G:'$D(@DDWDIC) FERR
32 S DDWDIC=$NA(@DDWDIC)
33 S DIC=$$OREF^DILF(DDWDIC)
34 ;
35 I IOSL>100 S DDWIOSL=IOSL,IOSL=24
36 S IOTM=$G(DDWTM,1)+2,IOBM=$G(DDWBM,IOSL)-3
37 I IOBM-IOTM<3 D BLD^DIALOG(202,"Top and/or Bottom Margin") G ERR
38 ;
39 S:'$G(DDWLMAR) DDWLMAR=1 S:'$G(DDWRMAR) DDWRMAR=74
40 I DDWRMAR'>DDWLMAR!(DDWLMAR>231)!(DDWRMAR>245) D BLD^DIALOG(202,"Left and/or Right Margin") G ERR
41 ;
42 D:$D(DDW("IN"))[0 GETKEY^DDWK
43 ;
44 D CLR
45 W:$P(DDGLED,DDGLDEL,2)]"" @$P(DDGLED,DDGLDEL,2)
46 X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
47 ;
48 K DDWL,^TMP("DDW",$J),^TMP("DDW1",$J)
49 S (DDWA,DDWSTB,DDWSTAT)=0,DDWBF="0010"
50 ;
51 S DDWREP=$G(DDWFLAGS)["R"
52 S DDWRAP=$G(DDWFLAGS)'["M"
53 I 'DDWRAP D
54 . S DDWLMAR(1)=DDWLMAR,DDWLMAR=1
55 . S DDWRMAR(1)=DDWRMAR,DDWRMAR=245
56 ;
57 I '$G(DDWRW),$G(DDWRW)'="B" S DDWRW=1
58 I '$G(DDWC),$G(DDWC)'="E" S DDWC=1
59 ;
60 S DDWTO=DTIME
61 S DDWOFS="0^20^^1",$P(DDWOFS,U,3)=IOM-$P(DDWOFS,U,2)
62 S DDWMR=IOBM-IOTM+1
63 ;
64 S:$G(DDWTAB)="" DDWTAB="+8"
65 S DDWRUL=$$RULER^DDW2(DDWTAB)
66 ;
67 I $G(DDWAUTO) D
68 . N DDWX,DDWERR
69 . S (DDWAUTO,DDWX)=$E(DDWAUTO,1,15)
70 . D AUTOVAL^DDW1
71 . I $D(DDWERR)#2!($G(DDWAUTO)'>0) K DDWAUTO Q
72 . S DDWAUTO("H")=$H
73 . S DDWAUTO("S")=DDWAUTO*60
74 E K DDWAUTO
75 Q
76 ;
77RESET ;Reset terminal and cleanup
78 D INIT^DDGLIB0() D:$G(DIERR) MSG^DIALOG("BW")
79 W $P($G(DDGLVID),DDGLDEL,10)
80 ;
81END ;Cleanup
82 S:$D(DDWIOSL)#2 IOSL=DDWIOSL
83 I $P(DDGLED,DDGLDEL,2)]"" D
84 . S IOTM=1,IOBM=$S($D(IOSL)#2:IOSL,1:24) W @$P(DDGLED,DDGLDEL,2)
85 D CLR
86 ;
87 K DDW,DDWA,DDWBF,DDWC,DDWCHG,DDWCNT,DDWDIC,DDWED,DDWFIN,DDWFIND,DDWHLOG
88 K DDWIOSL,DDWL,DDWMARK,DDWMR,DDWN,DDWOFS,DDWQ,DDWRAP,DDWREP
89 K DDWRUL,DDWRW,DDWSTAT,DDWSTB,DDWTC,DDWTO
90 K ^TMP("DDW",$J),^TMP("DDW1",$J),^TMP("DDWH",$J)
91 I $$ROUEXIST^DILIBF("XPDUTL"),$$VERSION^XPDUTL("XU")>7.1
92 E K ^TMP("DDWB",$J)
93 ;
94 ;D:'$D(DIWE) X^DIWE
95 I $D(DDS) D
96 . D:$D(DIWESW) KILL^DDGLIB0("K")
97 E D KILL^DDGLIB0($G(DDWFLAGS))
98 Q
99 ;
100CLR ;Clear screen
101 I $G(DDWTM,1)=1,$G(DDWBM,IOSL)=IOSL W $P(DDGLCLR,DDGLDEL,2)
102 E D
103 . S DX=0
104 . F DY=$G(DDWTM,1)-1:1:$G(DDWBM,IOSL)-1 X IOXY W $P(DDGLCLR,DDGLDEL)
105 Q
106 ;
107FERR ;File input parameter error
108 D BLD^DIALOG(202,"File")
109 D ERR
110 Q
111 ;
112ERR ;Error during setup
113 W $C(7),! D MSG^DIALOG("BW") W !
114 D KILL^DDGLIB0()
115 S DDWERR=1
116 Q
Note: See TracBrowser for help on using the repository browser.