Annotation of freem_fileman/USER/DDGFLOAD.m, revision 1.1
1.1 ! snw 1: DDGFLOAD ;SFISC/MKO-LOAD PAGE/BLOCK ;08:55 AM 15 Nov 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: PG(S,P,V,R) ;
! 5: ;Load and paint page
! 6: ;Called when a new form or page is selected
! 7: ;If Page is not pop-up close all windows first
! 8: ;Input:
! 9: ; S = internal form number
! 10: ; P = internal page number
! 11: ; V = 1 if buffer should be updated but nothing painted
! 12: ; (new windows are still given focus)
! 13: ; R = 1 to reload blocks/fields on page even if loaded before
! 14: ;Returns:
! 15: ; DDGFWID = Window number for a given page
! 16: ; DDGFWIDB = Window number of block displayer for a given page
! 17: ; DDGFLIM = Boundaries within which cursor can be moved
! 18: ;
! 19: I $D(^DIST(.403,+$G(S),40,+$G(P),0))[0 S DDGFWID="P0",DDGFWIDB="B0",DDGFLIM="0^0^"_(IOSL-8)_U_(IOM-2),DDGFPG=0 Q
! 20: ;
! 21: S DDGFWID="P"_DDGFPG,DDGFWIDB="B"_DDGFPG
! 22: I $$EXIST^DDGLIBW(DDGFWID),$G(R) D DESTROY^DDGLIBW(DDGFWID,1)
! 23: I $$EXIST^DDGLIBW(DDGFWID),'$G(R) D Q
! 24: . S DDGFLIM=$P(@DDGFREF@("F",P),U,1,4)
! 25: . I $P(DDGFLIM,U,3,4)?."^" D
! 26: .. S $P(DDGFLIM,U,3,4)=IOSL-8_U_(IOM-2)
! 27: .. D CLOSEALL^DDGLIBW($G(V))
! 28: . D FOCUS^DDGLIBW(DDGFWID,$G(V))
! 29: ;
! 30: N P1,P2,P3,P4,B,B1,B2
! 31: ;
! 32: ;Get page coordinates
! 33: I $D(@DDGFREF@("F",+P))#2 D
! 34: . N N
! 35: . S N=@DDGFREF@("F",+P)
! 36: . S P1=$P(N,U),P2=$P(N,U,2),P3=$P(N,U,3),P4=$P(N,U,4)
! 37: E D
! 38: . S P2=$P(^DIST(.403,+S,40,+P,0),U,3),P3=$P(^(0),U,7)
! 39: . S P1=$P(P2,",")-1,P2=$P(P2,",",2)-1
! 40: . S:P1<0 P1=0 S:P2<0 P2=0
! 41: . S:P3]"" P4=$P(P3,",",2)-1,P3=$P(P3,",")-1
! 42: . S @DDGFREF@("F",P)=P1_U_P2_U_$S(P3]"":P3_U_P4,1:U)_U_$P($G(^DIST(.403,+S,40,+P,1)),U)_U_$P(^(0),U)
! 43: ;
! 44: I P3]"" D
! 45: . S DDGFLIM=P1_U_P2_U_P3_U_P4
! 46: . D CREATE^DDGLIBW(DDGFWID,P1_U_P2_U_(P3-P1+1)_U_(P4-P2+1),1,$G(V))
! 47: . S @DDGFREF@("RC",DDGFWID,P1,P2,P4,"P","P","PTOP")=""
! 48: . S @DDGFREF@("RC",DDGFWID,P3,P4,P4,"P","P","PBRC")=""
! 49: ;
! 50: E D
! 51: . S DDGFLIM=P1_U_P2_U_(IOSL-8)_U_(IOM-2)
! 52: . D CLOSEALL^DDGLIBW($G(V))
! 53: . D CREATE^DDGLIBW(DDGFWID,P1_U_P2_U_(IOSL-7-P1)_U_(IOM-1-P2),"",$G(V))
! 54: ;
! 55: ;Load header block
! 56: S B=$P(^DIST(.403,+S,40,+P,0),U,2) I B]"" D
! 57: . S B1=P1,B2=P2
! 58: . D BK(+P,B,P1,P2,B1,B2,1,$G(V))
! 59: ;
! 60: ;Load all other blocks
! 61: S B=0 F S B=$O(^DIST(.403,+S,40,+P,40,B)) Q:B'=+$P(B,"E") D
! 62: . Q:$D(^DIST(.403,+S,40,+P,40,B,0))[0
! 63: . S B2=$P(^DIST(.403,+S,40,+P,40,B,0),U,3)
! 64: . S B1=$P(B2,",")-1,B2=$P(B2,",",2)-1
! 65: . S:B1<0 B1=0 S:B2<0 B2=0
! 66: . S B1=B1+P1,B2=B2+P2
! 67: . D BK(+P,B,P1,P2,B1,B2,"",$G(V))
! 68: Q
! 69: ;
! 70: BK(P,B,P1,P2,B1,B2,H,V) ;Load block image
! 71: ; P = internal page number
! 72: ; B = internal block number
! 73: ; P1 = page $Y
! 74: ; P2 = page $X
! 75: ; B1 = block abs $Y
! 76: ; B2 = block abs $X
! 77: ; H = 1 if header block, immobile (optional)
! 78: ; V = 1 if buffer should be updated but nothing painted (optional)
! 79: N B3,F,F1,C,C1,C2,C3,D1,D2,D3,L,N
! 80: Q:$D(^DIST(.404,B,0))[0
! 81: ;
! 82: S N=$P(^DIST(.404,B,0),U)
! 83: S:$G(H) B1=P1,B2=P2
! 84: S B3=B2+$L(N)-1
! 85: S @DDGFREF@("F",P,B)=B1_U_B2_U_B3_U_N
! 86: S @DDGFREF@("BKRC",DDGFWIDB,B1,B2,B3,B)=$S($G(H):"H",1:"")
! 87: ;
! 88: S F1=0
! 89: F S F1=$O(^DIST(.404,B,40,"B",F1)) Q:F1="" S F=$O(^(F1,"")) D:F
! 90: . Q:$D(^DIST(.404,B,40,F,0))[0
! 91: . S C=$P(^DIST(.404,B,40,F,0),U,2),C2=$P($G(^(2)),U,3)
! 92: . I C]"",'$P($G(^DIST(.404,B,40,F,2)),U,4),$P(^(0),U,3)'=1 S C=C_":"
! 93: . S C1=$P(C2,",")-1+B1,C2=$P(C2,",",2)-1+B2,C3=C2+$L(C)-1
! 94: . I $P(^DIST(.404,B,40,F,0),U,3)'=1 D
! 95: .. S L=$P($G(^DIST(.404,B,40,F,2)),U,2),D2=$P($G(^(2)),U)
! 96: .. S D1=$P(D2,",")-1+B1,D2=$P(D2,",",2)-1+B2,D3=D2+L-1
! 97: . I C]"" D
! 98: .. S @DDGFREF@("F",P,B,F)=C1_U_C2_U_C3_U_C
! 99: .. S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
! 100: .. D WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2,"",$G(V))
! 101: . I $P(^DIST(.404,B,40,F,0),U,3)'=1 D
! 102: .. S $P(@DDGFREF@("F",P,B,F),U,5,8)=D1_U_D2_U_D3_U_L
! 103: .. S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
! 104: .. D WRITE^DDGLIBW(DDGFWID,$TR($J("",L)," ","_"),D1-P1,D2-P2,"",$G(V))
! 105: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>