| [613] | 1 | DDW4 ;SFISC/PD KELTZ-OTHER NAVIGATION, DEL ;2:54 PM 23 Aug 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**18**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | TAB N DDWX
|
|---|
| 6 | S DDWX=$F(DDWRUL,"T",DDWC+1) G:'DDWX ERR
|
|---|
| 7 | D POS(DDWRW,DDWX-1,"R")
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | DEOL S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
|
|---|
| 11 | W $P(DDGLCLR,DDGLDEL)
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | DELW N DDWI,DDWW
|
|---|
| 15 | I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
|
|---|
| 16 | I DDWC>$L(DDWN) D Q
|
|---|
| 17 | . I DDWN?." " D
|
|---|
| 18 | .. D XLINE^DDW5()
|
|---|
| 19 | . E D
|
|---|
| 20 | .. N DDWY,DDWX
|
|---|
| 21 | .. S DDWY=DDWRW+DDWA,DDWX=DDWC
|
|---|
| 22 | .. D JOIN^DDW6
|
|---|
| 23 | .. D POS(DDWY-DDWA,DDWX,"RN")
|
|---|
| 24 | ;
|
|---|
| 25 | S DDWI=$$WRPOS(DDWN)
|
|---|
| 26 | S DDWW=$E(DDWN,DDWC,DDWI-1)
|
|---|
| 27 | S $E(DDWN,DDWC,DDWI-1)="",DDWL(DDWRW)=DDWN
|
|---|
| 28 | I $P(DDGLED,DDGLDEL,6)]"" D
|
|---|
| 29 | . F DDWI=1:1:$L(DDWW) W $P(DDGLED,DDGLDEL,6)
|
|---|
| 30 | . S DDWI=$E(DDWN,IOM-$L(DDWW)+1+DDWOFS,IOM+DDWOFS)
|
|---|
| 31 | . I DDWI]"" D CUP(DDWRW,IOM-$L(DDWW)+1) W DDWI D CUP(DDWRW,DDWC-DDWOFS)
|
|---|
| 32 | E D
|
|---|
| 33 | . W $E(DDWN_$J("",$L(DDWW)),DDWC,IOM+DDWOFS)
|
|---|
| 34 | . D CUP(DDWRW,DDWC-DDWOFS)
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | WORDR N DDWI
|
|---|
| 38 | S DDWI=$$WRPOS(DDWN)
|
|---|
| 39 | D POS(DDWRW,DDWI,"R")
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | WRPOS(DDWT) ;
|
|---|
| 43 | N DDWP,DDWS
|
|---|
| 44 | S DDWT=$$PUNC(DDWT)
|
|---|
| 45 | S DDWS=$F(DDWT," ",DDWC+1),DDWP=$F(DDWT,"!",DDWC+1)
|
|---|
| 46 | S:'DDWS DDWS=999 S:'DDWP DDWP=999
|
|---|
| 47 | ;
|
|---|
| 48 | I DDWC>$L(DDWT) D
|
|---|
| 49 | . I DDWRW+DDWA'<DDWCNT S DDWI=$L(DDWT)+1
|
|---|
| 50 | . E D DN^DDWT1 S DDWI=1
|
|---|
| 51 | E I DDWS=999,DDWP=999 D
|
|---|
| 52 | . S DDWI=$L(DDWT)+1
|
|---|
| 53 | E I $E(DDWT,DDWC)="!" D
|
|---|
| 54 | . F DDWI=DDWC+1:1 Q:$E(DDWT,DDWI)'="!"
|
|---|
| 55 | . F DDWI=DDWI:1 Q:$E(DDWT,DDWI)'=" "
|
|---|
| 56 | E I DDWS<DDWP D
|
|---|
| 57 | . F DDWI=DDWS:1 Q:$E(DDWT,DDWI)'=" "
|
|---|
| 58 | E S DDWI=DDWP-1
|
|---|
| 59 | Q DDWI
|
|---|
| 60 | ;
|
|---|
| 61 | WORDL N DDWD,DDWI,DDWT
|
|---|
| 62 | S DDWT=$$PUNC(DDWN)
|
|---|
| 63 | ;
|
|---|
| 64 | I DDWC=1 D
|
|---|
| 65 | . I DDWRW=1,'DDWA S DDWI=1
|
|---|
| 66 | . E D UP^DDWT1 S DDWI=$L(DDWN)+1
|
|---|
| 67 | E D
|
|---|
| 68 | . S DDWI=DDWC-1
|
|---|
| 69 | . S:$E(DDWT,DDWI)="" DDWI=$L(DDWT)
|
|---|
| 70 | . I $E(DDWT,DDWI)=" " F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'=" "
|
|---|
| 71 | . I $E(DDWT,DDWI)="!" D
|
|---|
| 72 | .. F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'="!"
|
|---|
| 73 | . E I DDWI D
|
|---|
| 74 | .. F DDWI=DDWI-1:-1:0 Q:" !"[$E(DDWT,DDWI)
|
|---|
| 75 | . S DDWI=DDWI+1
|
|---|
| 76 | D POS(DDWRW,DDWI,"R")
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | PGDN N DDWX
|
|---|
| 80 | I DDWRW<DDWMR D
|
|---|
| 81 | . D POS($$MIN(DDWCNT-DDWA,DDWMR),DDWC,"RN")
|
|---|
| 82 | E D
|
|---|
| 83 | . S DDWX=$$MIN(DDWSTB,DDWMR)
|
|---|
| 84 | . D:DDWX MVFWD^DDW3(DDWX)
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | PGUP N DDWX
|
|---|
| 88 | I DDWRW>1 D
|
|---|
| 89 | . D POS(1,DDWC,"RN")
|
|---|
| 90 | E D
|
|---|
| 91 | . S DDWX=$$MIN(DDWA,DDWMR)
|
|---|
| 92 | . D:DDWX MVBCK^DDW3(DDWX)
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | JLEFT I DDWC=1,'DDWOFS Q
|
|---|
| 96 | N DDWX
|
|---|
| 97 | I DDWN?." " S DDWX=1
|
|---|
| 98 | E F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
|
|---|
| 99 | I DDWC-DDWOFS=1,DDWC>1 D POS(DDWRW,DDWC-1,"R") Q:DDWC=DDWX
|
|---|
| 100 | S DDWC=$$MAX($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:0),1+DDWOFS)
|
|---|
| 101 | D POS(DDWRW,DDWC,"R")
|
|---|
| 102 | Q
|
|---|
| 103 | JRIGHT N DDWX
|
|---|
| 104 | S DDWX=$L(DDWN)+1
|
|---|
| 105 | I DDWC-DDWOFS=IOM,DDWC<246 D POS(DDWRW,DDWC+1,"R") Q:DDWC=DDWX
|
|---|
| 106 | S DDWC=$$MIN($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:999),$$MIN(IOM+DDWOFS,246))
|
|---|
| 107 | D POS(DDWRW,DDWC,"R")
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | LBEG N DDWX
|
|---|
| 111 | I DDWN?." " D POS(DDWRW,1,"R") Q
|
|---|
| 112 | I $E(DDWN,1,DDWC-1)?." ",$E(DDWN,DDWC)'=" " D POS(DDWRW,1,"R") Q
|
|---|
| 113 | F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
|
|---|
| 114 | D POS(DDWRW,DDWX,"R")
|
|---|
| 115 | Q
|
|---|
| 116 | LEND D POS(DDWRW,"E","R")
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
| 119 | ERR ;Beep
|
|---|
| 120 | W $C(7)
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | CUP(Y,X) ;Cursor positioning
|
|---|
| 124 | S DY=IOTM+Y-2,DX=X-1 X IOXY
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | POS(R,C,F) ;Pos cursor based on char pos C
|
|---|
| 128 | N DDWX
|
|---|
| 129 | S:$G(C)="E" C=$L($G(DDWL(R)))+1
|
|---|
| 130 | S:$G(F)["N" DDWN=$G(DDWL(R))
|
|---|
| 131 | S:$G(F)["R" DDWRW=R,DDWC=C
|
|---|
| 132 | ;
|
|---|
| 133 | S DDWX=C-DDWOFS
|
|---|
| 134 | I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
|
|---|
| 135 | S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
|
|---|
| 136 | Q
|
|---|
| 137 | ;
|
|---|
| 138 | SCR(C) ;Screen #
|
|---|
| 139 | Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
|
|---|
| 140 | ;
|
|---|
| 141 | MIN(X,Y) ;
|
|---|
| 142 | Q $S(X<Y:X,1:Y)
|
|---|
| 143 | MAX(X,Y) ;
|
|---|
| 144 | Q $S(X>Y:X,1:Y)
|
|---|
| 145 | PUNC(X) ;
|
|---|
| 146 | Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?",$TR($J("",32)," ","!"))
|
|---|
