Return to DDGFLOAD.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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