DDW1 ;SFISC/PD KELTZ-LOAD, SAVE ;06:12 PM 13 Dec 1994 ;;21.0;VA FileMan;;Dec 28, 1994 ;Per VHA Directive 10-93-142, this routine should not be modified. ; LOAD ;Put up "box" and load document N DDWI,DDWX D BOX ; I $D(DWLC)[0 D . S DWLC=$S($D(@DDWDIC@(0))#2:+$P(@DDWDIC@(0),U,4),1:$O(@DDWDIC@(""),-1)) . S:$D(@DDWDIC@(1))#2 $E(DDWBF,4)=1 S DDWCNT=$S(DWLC:DWLC,1:1) ; D:DDWCNT>1 MSG^DDW("Loading text ...") F DDWI=DDWCNT:-1:DDWMR+1 D . S DDWSTB=DDWSTB+1 . S ^TMP("DDW1",$J,DDWSTB)=$S('$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI))) ; F DDWI=1:1:DDWMR D . S DDWX=$S(DDWI>DDWCNT:"",'$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI))) . S DDWL(DDWI)=DDWX . I DDWC'>IOM,DDWRW'>DDWMR,DDWI'>DDWCNT,DDWX'?." " D .. D CUP(DDWI,1) W $E(DDWX,1,IOM) ; I DDWCNT=1,DDWL(1)?1." " S DDWL(1)="" D:DDWCNT>1 MSG^DDW() I DDWRW="B" D . D BOT^DDW3 E D LINE^DDWG(DDWRW,DDWC) Q ; BOX ;Draw box N DDWX ; I $D(DIWETXT) D . D CUP(-1,1) . W $P(DDGLVID,DDGLDEL)_$E(DIWETXT,1,IOM)_$P(DDGLVID,DDGLDEL,10) ; I $D(DIWESUB) S DDWX=DIWESUB E I $D(XMSUB),DIC["^XMB" D . S DDWX=XMSUB . F Q:DDWX'["~U~" S DDWX=$P(DDWX,"~U~")_U_$P(DDWX,"~U~",2,999) E I $D(DH)#2,$D(DIE) S DDWX=DH S DDWX=$E($G(DDWX),1,30) ; D CUP(0,1) W $TR($J("",IOM)," ","=") I DDWRAP S DX=2 X IOXY W "[ WRAP ]" S DX=12 X IOXY W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=") S DX=40-($L(DDWX)\2) X IOXY W "< "_$E(DDWX,1,30)_" >" S DX=61 X IOXY W "[ H=Help ]" ; D CUP(DDWMR+1,1) W $E(DDWRUL,1,IOM) I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D . S DX=DDWLMAR-DDWOFS-1 X IOXY W "<" I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D . S DX=DDWRMAR-DDWOFS-1 X IOXY W ">" Q ; SV ;Called from DDWT1 D SAVE I DDWRW+DDWA>DDWCNT D . D POS(DDWCNT-DDWA,"E","RN") E D POS(DDWRW,DDWC) Q ; SAVE ;Save document N DDWI,DDWLMEM,DDWLSTB,DDWX D MSG^DDW("Saving text ...") H .5 S DDWCNT=0 K @DDWDIC ; F DDWI=1:1:DDWA D . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW",$J,DDWI)) . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX . E S @DDWDIC@(DDWCNT)=DDWX ; S DDWLMEM=999 F DDWI=1:1:DDWSTB+1 Q:DDWI>DDWSTB Q:^TMP("DDW1",$J,DDWI)'?." " I DDWI'>DDWSTB S DDWLSTB=DDWI E D . F DDWI=DDWMR:-1:0 Q:'DDWI Q:DDWL(DDWI)'?." " . S DDWLMEM=DDWI ; F DDWI=1:1:$$MIN(DDWLMEM,DDWMR) D . S DDWCNT=DDWCNT+1,DDWX=$$NTS(DDWL(DDWI)) . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX . E S @DDWDIC@(DDWCNT)=DDWX ; I $D(DDWLSTB) F DDWI=DDWSTB:-1:DDWLSTB D . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW1",$J,DDWI)) . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX . E S @DDWDIC@(DDWCNT)=DDWX ; S DWLC=DDWCNT,DWHD=U I DDWCNT,'$E(DDWBF,4) S @DDWDIC@(0)=U_U_DWLC_U_DWLC_U_DT_U D MSG^DDW() Q ; POS(R,C,F) ;Pos cursor based on char pos C N DDWX S:$G(C)="E" C=$L($G(DDWL(R)))+1 S:$G(F)["N" DDWN=$G(DDWL(R)) S:$G(F)["R" DDWRW=R,DDWC=C ; S DDWX=C-DDWOFS I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS) S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY Q ; CUP(Y,X) ;Cursor positioning S DY=IOTM+Y-2,DX=X-1 X IOXY Q ; MIN(X,Y) ;Return the minimum of X and Y Q $S(X