Return to DDGFLOAD.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDGFLOAD.m, revision 1.1.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