freem_fileman/USER/DDW1.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DDW1.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

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