Return to DDW1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDW1.m, revision 1.1

1.1     ! snw         1: DDW1   ;SFISC/PD KELTZ-LOAD, SAVE ;06:12 PM  13 Dec 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: LOAD   ;Put up "box" and load document
        !             6:        N DDWI,DDWX
        !             7:        D BOX
        !             8:        ;
        !             9:        I $D(DWLC)[0 D
        !            10:        . S DWLC=$S($D(@DDWDIC@(0))#2:+$P(@DDWDIC@(0),U,4),1:$O(@DDWDIC@(""),-1))
        !            11:        . S:$D(@DDWDIC@(1))#2 $E(DDWBF,4)=1
        !            12:        S DDWCNT=$S(DWLC:DWLC,1:1)
        !            13:        ;
        !            14:        D:DDWCNT>1 MSG^DDW("Loading text ...")
        !            15:        F DDWI=DDWCNT:-1:DDWMR+1 D
        !            16:        . S DDWSTB=DDWSTB+1
        !            17:        . S ^TMP("DDW1",$J,DDWSTB)=$S('$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
        !            18:        ;
        !            19:        F DDWI=1:1:DDWMR D
        !            20:        . S DDWX=$S(DDWI>DDWCNT:"",'$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
        !            21:        . S DDWL(DDWI)=DDWX
        !            22:        . I DDWC'>IOM,DDWRW'>DDWMR,DDWI'>DDWCNT,DDWX'?." " D
        !            23:        .. D CUP(DDWI,1) W $E(DDWX,1,IOM)
        !            24:        ;
        !            25:        I DDWCNT=1,DDWL(1)?1." " S DDWL(1)=""
        !            26:        D:DDWCNT>1 MSG^DDW()
        !            27:        I DDWRW="B" D
        !            28:        . D BOT^DDW3
        !            29:        E  D LINE^DDWG(DDWRW,DDWC)
        !            30:        Q
        !            31:        ;
        !            32: BOX    ;Draw box
        !            33:        N DDWX
        !            34:        ;
        !            35:        I $D(DIWETXT) D
        !            36:        . D CUP(-1,1)
        !            37:        . W $P(DDGLVID,DDGLDEL)_$E(DIWETXT,1,IOM)_$P(DDGLVID,DDGLDEL,10)
        !            38:        ;
        !            39:        I $D(DIWESUB) S DDWX=DIWESUB
        !            40:        E  I $D(XMSUB),DIC["^XMB" D
        !            41:        . S DDWX=XMSUB
        !            42:        . F  Q:DDWX'["~U~"  S DDWX=$P(DDWX,"~U~")_U_$P(DDWX,"~U~",2,999)
        !            43:        E  I $D(DH)#2,$D(DIE) S DDWX=DH
        !            44:        S DDWX=$E($G(DDWX),1,30)
        !            45:        ;
        !            46:        D CUP(0,1) W $TR($J("",IOM)," ","=")
        !            47:        I DDWRAP S DX=2 X IOXY W "[ WRAP ]"
        !            48:        S DX=12 X IOXY W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
        !            49:        S DX=40-($L(DDWX)\2) X IOXY W "< "_$E(DDWX,1,30)_" >"
        !            50:        S DX=61 X IOXY W "[ <PF1>H=Help ]"
        !            51:        ;
        !            52:        D CUP(DDWMR+1,1) W $E(DDWRUL,1,IOM)
        !            53:        I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
        !            54:        . S DX=DDWLMAR-DDWOFS-1 X IOXY W "<"
        !            55:        I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
        !            56:        . S DX=DDWRMAR-DDWOFS-1 X IOXY W ">"
        !            57:        Q
        !            58:        ;
        !            59: SV     ;Called from DDWT1
        !            60:        D SAVE
        !            61:        I DDWRW+DDWA>DDWCNT D
        !            62:        . D POS(DDWCNT-DDWA,"E","RN")
        !            63:        E  D POS(DDWRW,DDWC)
        !            64:        Q
        !            65:        ;
        !            66: SAVE   ;Save document
        !            67:        N DDWI,DDWLMEM,DDWLSTB,DDWX
        !            68:        D MSG^DDW("Saving text ...") H .5
        !            69:        S DDWCNT=0
        !            70:        K @DDWDIC
        !            71:        ;
        !            72:        F DDWI=1:1:DDWA D
        !            73:        . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW",$J,DDWI))
        !            74:        . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
        !            75:        . E  S @DDWDIC@(DDWCNT)=DDWX
        !            76:        ;
        !            77:        S DDWLMEM=999
        !            78:        F DDWI=1:1:DDWSTB+1 Q:DDWI>DDWSTB  Q:^TMP("DDW1",$J,DDWI)'?." "
        !            79:        I DDWI'>DDWSTB S DDWLSTB=DDWI
        !            80:        E  D
        !            81:        . F DDWI=DDWMR:-1:0 Q:'DDWI  Q:DDWL(DDWI)'?." "
        !            82:        . S DDWLMEM=DDWI
        !            83:        ;
        !            84:        F DDWI=1:1:$$MIN(DDWLMEM,DDWMR) D
        !            85:        . S DDWCNT=DDWCNT+1,DDWX=$$NTS(DDWL(DDWI))
        !            86:        . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
        !            87:        . E  S @DDWDIC@(DDWCNT)=DDWX
        !            88:        ;
        !            89:        I $D(DDWLSTB) F DDWI=DDWSTB:-1:DDWLSTB D
        !            90:        . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW1",$J,DDWI))
        !            91:        . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
        !            92:        . E  S @DDWDIC@(DDWCNT)=DDWX
        !            93:        ;
        !            94:        S DWLC=DDWCNT,DWHD=U
        !            95:        I DDWCNT,'$E(DDWBF,4) S @DDWDIC@(0)=U_U_DWLC_U_DWLC_U_DT_U
        !            96:        D MSG^DDW()
        !            97:        Q
        !            98:        ;
        !            99: POS(R,C,F)     ;Pos cursor based on char pos C
        !           100:        N DDWX
        !           101:        S:$G(C)="E" C=$L($G(DDWL(R)))+1
        !           102:        S:$G(F)["N" DDWN=$G(DDWL(R))
        !           103:        S:$G(F)["R" DDWRW=R,DDWC=C
        !           104:        ;
        !           105:        S DDWX=C-DDWOFS
        !           106:        I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
        !           107:        S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
        !           108:        Q
        !           109:        ;
        !           110: CUP(Y,X)       ;Cursor positioning
        !           111:        S DY=IOTM+Y-2,DX=X-1 X IOXY
        !           112:        Q
        !           113:        ;
        !           114: MIN(X,Y)       ;Return the minimum of X and Y
        !           115:        Q $S(X<Y:X,1:Y)
        !           116:        ;
        !           117: NTS(X) ;Change "" to " "
        !           118:        Q $S(X="":" ",1:X)
        !           119:        ;
        !           120: TR(X,F)        ;Strip trailing blanks
        !           121:        ;If F["B" return " " if X=""
        !           122:        I $G(X)]"" D
        !           123:        . N I
        !           124:        . F I=$L(X):-1:0 Q:$E(X,I)'=" "
        !           125:        . S X=$E(X,1,I)
        !           126:        I X="",$G(F)["B" S X=" "
        !           127:        Q X