Annotation of freem_fileman/DDW2.m, revision 1.1.1.1

1.1       snw         1: DDW2   ;SFISC/MKO-SETTINGS, MODES ;08:17 AM  30 Aug 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        ;
                      5: TSET   N DDWX
                      6:        S DDWX=$E(DDWRUL,DDWC)
                      7:        S DDWX=$S(DDWX="T":"=",DDWX="=":"T",1:DDWX)
                      8:        S $E(DDWRUL,DDWC)=DDWX
                      9:        I DDWC'=DDWLMAR,DDWC'=DDWRMAR D
                     10:        . D CUP(DDWMR+1,DDWC-DDWOFS) W DDWX
                     11:        . D POS(DDWRW,DDWC)
                     12:        Q
                     13:        ;
                     14: LSET   I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
                     15:        I DDWC>231 D ERR("Left margin cannot be set beyond column 231") Q
                     16:        I DDWC'<DDWRMAR D ERR("Left margin must be left of right margin") Q
                     17:        I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
                     18:        . D CUP(DDWMR+1,DDWLMAR-DDWOFS) W $E(DDWRUL,DDWLMAR)
                     19:        D CUP(DDWMR+1,DDWC-DDWOFS) W "<" D POS(DDWRW,DDWC)
                     20:        S DDWLMAR=DDWC
                     21:        Q
                     22:        ;
                     23: RSET   I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
                     24:        I DDWC>245 D ERR("Right margin cannot be set beyond column 245") Q
                     25:        I DDWC'>DDWLMAR D ERR("Right margin must be right of left margin") Q
                     26:        I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
                     27:        . D CUP(DDWMR+1,DDWRMAR-DDWOFS) W $E(DDWRUL,DDWRMAR)
                     28:        D CUP(DDWMR+1,DDWC-DDWOFS) W ">" D POS(DDWRW,DDWC)
                     29:        S DDWRMAR=DDWC
                     30:        Q
                     31:        ;
                     32: WRAPM  S DDWRAP=DDWRAP+1#2
                     33:        D CUP(0,3) W $S(DDWRAP:"[ WRAP ]",1:"========")
                     34:        I 'DDWRAP D
                     35:        . S DDWLMAR(1)=DDWLMAR,DDWLMAR=1
                     36:        . S DDWRMAR(1)=DDWRMAR,DDWRMAR=245
                     37:        E  D
                     38:        . S DDWLMAR=DDWLMAR(1) K DDWLMAR(1)
                     39:        . S DDWRMAR=DDWRMAR(1) K DDWRMAR(1)
                     40:        D RULER^DDW3,POS(DDWRW,DDWC)
                     41:        Q
                     42:        ;
                     43: REPLM  S DDWREP=DDWREP+1#2
                     44:        D CUP(0,13) W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
                     45:        D POS(DDWRW,DDWC)
                     46:        Q
                     47:        ;
                     48: STAT   S DDWSTAT=DDWSTAT+1#2
                     49:        I DDWSTAT D
                     50:        . S DDWTO=1,DDWTC=1
                     51:        E  D
                     52:        . D CUP(DDWMR+2,1)
                     53:        . W $P(DDGLCLR,DDGLDEL) D POS(DDWRW,DDWC)
                     54:        . S DDWTO=DTIME
                     55:        Q
                     56:        ;
                     57: CUP(Y,X)       ;Cursor positioning
                     58:        S DY=IOTM+Y-2,DX=X-1 X IOXY
                     59:        Q
                     60:        ;
                     61: POS(R,C,F)     ;Pos cursor based on char pos C
                     62:        N DDWX
                     63:        S:$G(C)="E" C=$L($G(DDWL(R)))+1
                     64:        S:$G(F)["N" DDWN=$G(DDWL(R))
                     65:        S:$G(F)["R" DDWRW=R,DDWC=C
                     66:        ;
                     67:        S DDWX=C-DDWOFS
                     68:        I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
                     69:        S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
                     70:        Q
                     71:        ;
                     72: SCR(C) ;Return screen number
                     73:        Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
                     74:        ;
                     75: ERR(DDWX)      ;Error
                     76:        W $C(7)
                     77:        D MSG^DDW(DDWX) H 2 D MSG^DDW()
                     78:        F  R *DDWX:0 E  Q
                     79:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>