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>