Annotation of freem_fileman/DDGFEL.m, revision 1.1
1.1 ! snw 1: DDGFEL ;SFISC/MKO-SELECT OR EDIT ELEMENT ;02:53 PM 12 Oct 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;
! 5: SELECT ;Select an element
! 6: N B,F,T,C,C1,C2,C3,D,D1,D2,D3,L,P1,P2
! 7: D GETELEM(DY,DX) Q:$G(F)=""
! 8: ;
! 9: I F="P" G ^DDGFAPC
! 10: ;
! 11: ;Clear and/or kill portions of DDGFREF
! 12: S:T="D" $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=""
! 13: K:T="C" @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C"),@DDGFREF@("F",DDGFPG,B,F)
! 14: K:$D(D) @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")
! 15: ;
! 16: D COVER
! 17: G ^DDGF2
! 18: ;
! 19: EDIT ;Edit a caption or data length
! 20: N B,F,T,C,C1,C2,C3,D,D1,D2,D3,L,P1,P2,X,Y
! 21: D GETELEM(DY,DX) Q:"P"[$G(F)
! 22: ;
! 23: S DDGFCHG=1
! 24: I T="C" D
! 25: . K D,D1,D2,D3,L
! 26: . S $P(@DDGFREF@("F",DDGFPG,B,F),U,1,4)="^^^"
! 27: . K @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")
! 28: . D COVER
! 29: . D
! 30: .. N DX,DY
! 31: .. S DY=IOSL-6,DX=IOM-9 X IOXY W "EDIT "
! 32: . ;
! 33: . N DDGFCOD,DDGFX
! 34: . D EN^DIR0(C1,C2,$L(C),1,C,"","","","KWT",.DDGFX,.DDGFCOD)
! 35: . S X=DDGFX
! 36: . I $P(DDGFCOD,U)="TO" W $C(7) S X=C
! 37: . S:X["^" X=C
! 38: . S C3=C2+$L(X)-1
! 39: . ;
! 40: . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
! 41: . D WRITE^DDGLIBW(DDGFWID,X,C1-P1,C2-P2)
! 42: . I $L(X)<$L(C) D REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C3+1-P2)_U_1_U_($L(C)-$L(X)))
! 43: . S $P(@DDGFREF@("F",DDGFPG,B,F),U,1,4)=C1_U_C2_U_C3_U_X,$P(^(F),U,9)=1
! 44: ;
! 45: I T="D" D
! 46: . K C,C1,C2,C3
! 47: . S $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=""
! 48: . K @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F)
! 49: . D COVER,^DDGFADL
! 50: . ;
! 51: . S $P(@DDGFREF@("F",DDGFPG,B,F),U,5,8)=D1_U_D2_U_D3_U_L,$P(^(F),U,9)=1
! 52: . S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
! 53: . D WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
! 54: ;
! 55: D RC(DY,DX)
! 56: Q
! 57: ;
! 58: GETELEM(DY,DX) ;Which element is the cursor on
! 59: ;Returns P,B,F,T,C,C1,C2,C3,D,D1,D2,D3,L,P1,P2
! 60: ;If on pop-up page border, return only B="P",F="P",T="PTOP" or "PBRC"
! 61: ;Set P=page,B=Block,F=DDO,T=type ("D" or "C")
! 62: ;If cursor is not on anything, $G(F)=""
! 63: ;
! 64: Q:'$D(@DDGFREF@("RC",DDGFWID,DY))
! 65: N X1,X2,F1
! 66: S X1="" K F
! 67: F S X1=$O(@DDGFREF@("RC",DDGFWID,DY,X1)) Q:X1=""!(DX<X1) D
! 68: . S X2=""
! 69: . F S X2=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2)) Q:X2="" D Q:$G(F)
! 70: .. Q:DX>X2
! 71: .. S B=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,""))
! 72: .. S F=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,B,""))
! 73: .. S T=$O(@DDGFREF@("RC",DDGFWID,DY,X1,X2,B,F,""))
! 74: Q:"P"[$G(F)
! 75: ;
! 76: S P1=$P(DDGFLIM,U),P2=$P(DDGFLIM,U,2)
! 77: S F1=$G(@DDGFREF@("F",DDGFPG,B,F))
! 78: ;
! 79: ;Get caption, data, and coordinates
! 80: S C1=$P(F1,U),C2=$P(F1,U,2),C3=$P(F1,U,3),C=$P(F1,U,4)
! 81: I $P(F1,U,8)]"" D
! 82: . S D1=$P(F1,U,5),D2=$P(F1,U,6),D3=$P(F1,U,7)
! 83: . S L=$P(F1,U,8),D=$TR($J("",L)," ","_")
! 84: Q
! 85: ;
! 86: COVER ;Look for covered (hidden) fields
! 87: ;Input:
! 88: ; T,C,C1,C2,P1,P2
! 89: ;H(DDO) - array of hidden fields
! 90: ;Erase the element we've selected from buffer
! 91: ;Redraw the element(s) that were covered
! 92: N H,O,X1,X2,Y
! 93: F Y="C1","D1" D
! 94: . I Y="C1",T'="C" Q
! 95: . I Y="D1",'$D(D) Q
! 96: . S X1=""
! 97: . F S X1=$O(@DDGFREF@("RC",DDGFWID,@Y,X1)) Q:X1="" D
! 98: .. S X2=""
! 99: .. F S X2=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2)) Q:X2="" D
! 100: ... N B
! 101: ... S B=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2,""))
! 102: ... S O=$O(@DDGFREF@("RC",DDGFWID,@Y,X1,X2,B,""))
! 103: ... I O]"",$D(H(O))[0 D
! 104: .... I T="C",$$OVERLAP(C2,C3,X1,X2) S H(O)=DDGFPG_U_B
! 105: .... E I $D(D),$$OVERLAP(D2,D3,X1,X2) S H(O)=DDGFPG_U_B
! 106: ;
! 107: ;Clear in buffer area occupied by element(s) selected
! 108: D:T="C" CLEAR(C,C1,C2,C3)
! 109: D:$D(D) CLEAR(D,D1,D2,D3)
! 110: ;
! 111: ;Write to buffer the overlapped field(s)
! 112: I $D(H) S H="" F S H=$O(H(H)) Q:H="" D
! 113: . S O=$G(@DDGFREF@("F",$P(H(H),U),$P(H(H),U,2),H)) Q:O=""
! 114: . D WRITE^DDGLIBW(DDGFWID,$P(O,U,4),$P(O,U)-P1,$P(O,U,2)-P2,"",1)
! 115: . I $P(O,U,8)>0 D WRITE^DDGLIBW(DDGFWID,$TR($J("",$P(O,U,8))," ","_"),$P(O,U,5)-P1,$P(O,U,6)-P2,"",1)
! 116: Q
! 117: ;
! 118: OVERLAP(A1,A2,B1,B2) ;Does line with X-coords A1,A2 overlap B1,B2
! 119: N T
! 120: I A1<B1 S T=A1,A1=B1,B1=T,T=A2,A2=B2,B2=T
! 121: Q A1'<B1&(A1'>B2)!(A2'<B1&(A2'>B2))
! 122: ;
! 123: RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
! 124: N S
! 125: I DDGFR D
! 126: . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
! 127: . X IOXY W S_$J("",7-$L(S))
! 128: S DY=DDGFY,DX=DDGFX X IOXY
! 129: Q
! 130: ;
! 131: CLEAR(C,C1,C2,C3) ;Clear in buffer area occupied by element(s) selected
! 132: ;If on the page border, redraw the lines
! 133: N L
! 134: S L=$J("",$L(C)-$S(C3>$P(DDGFLIM,U,4):C3-$P(DDGFLIM,U,4),1:0))
! 135: D WRITE^DDGLIBW(DDGFWID,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
! 136: ;
! 137: I $P(@DDGFREF@("F",DDGFPG),U,3) D
! 138: . I C1=$P(DDGFLIM,U)!(C1=$P(DDGFLIM,U,3)) D
! 139: .. S L=$TR(L," ",$P(DDGLGRA,DDGLDEL,3))
! 140: .. S:C2=$P(DDGFLIM,U,2) $E(L)=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):5,1:7))
! 141: .. S:C3'<$P(DDGFLIM,U,4) $E(L,$L(L))=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):6,1:8))
! 142: .. D WRITE^DDGLIBW(DDGFWID,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
! 143: . E I C2=$P(DDGFLIM,U,2) D
! 144: .. D WRITE^DDGLIBW(DDGFWID,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
! 145: . E I C3'<$P(DDGFLIM,U,4) D
! 146: .. D WRITE^DDGLIBW(DDGFWID,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),$P(DDGFLIM,U,4)-$P(DDGFLIM,U,2),"G",1)
! 147: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDGFEL.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman