Annotation of freem_fileman/USER/DDSPRNT2.m, revision 1.1

1.1     ! snw         1: DDSPRNT2       ;MKO,SFISC/MKO-PRINT A FORM ;01:26 PM  14 Nov 1994;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: BLOCK  ;Print Block properties from Block file
        !             6:        D WP^DDSPRNT($NA(^DIST(.404,DDSBK,15)),DDSCOL2+1) Q:$D(DIRUT)
        !             7:        ;
        !             8:        D WR("DATA DICTIONARY NUMBER:",$P(DDSBK(0),U,2),1) Q:$D(DIRUT)
        !             9:        S X=$P(DDSBK(0),U,3)
        !            10:        I X]"" D WR("DISABLE NAVIGATION:",$$EXTERNAL^DILFD(.404,2,"",$P(DDSBK(0),U,3))) Q:$D(DIRUT)
        !            11:        ;
        !            12:        D WR("PRE ACTION:",$G(^DIST(.404,DDSBK,11))) Q:$D(DIRUT)
        !            13:        D WR("POST ACTION:",$G(^DIST(.403,DDSBK,12))) Q:$D(DIRUT)
        !            14:        K DDSBK(0)
        !            15:        ;
        !            16:        ;Loop through all fields
        !            17:        I $X D W() Q:$D(DIRUT)
        !            18:        Q:'$O(^DIST(.404,DDSBK,40,0))
        !            19:        ;
        !            20:        D:$Y+7'<IOSL HEADER^DDSPRNT Q:$D(DIRUT)
        !            21:        W !?DDSCOL2,"Field  Field"
        !            22:        W !?DDSCOL2,"Order  Properties"
        !            23:        W !?DDSCOL2,"-----  ----------"
        !            24:        ;
        !            25:        N DDSFD,DDSFDO
        !            26:        S DDSFDO=""
        !            27:        F  S DDSFDO=$O(^DIST(.404,DDSBK,40,"B",DDSFDO)) Q:DDSFDO=""!$D(DIRUT)  S DDSFD=0 F  S DDSFD=$O(^DIST(.404,DDSBK,40,"B",DDSFDO,DDSFD)) Q:'DDSFD!$D(DIRUT)  D FIELD
        !            28:        ;
        !            29:        Q
        !            30:        ;
        !            31: FIELD  ;Print Block properties
        !            32:        S DDSCOL1=15,DDSCOL2=22,DDSCOL3=45
        !            33:        F X=0,2,4,20 S DDSFD(X)=$G(^DIST(.404,DDSBK,40,DDSFD,X))
        !            34:        Q:DDSFD(0)=""
        !            35:        ;
        !            36:        D W(DDSFDO,DDSCOL1) Q:$D(DIRUT)
        !            37:        W ?DDSCOL2,"FIELD TYPE:"
        !            38:        W ?DDSCOL3,$$EXTERNAL^DILFD(.4044,2,"",$P(DDSFD(0),U,3))
        !            39:        ;
        !            40:        D WR("CAPTION:",$P(DDSFD(0),U,2)) Q:$D(DIRUT)
        !            41:        D WR("EXECUTABLE CAPTION:",$G(^DIST(.404,DDSBK,40,DDSFD,.1))) Q:$D(DIRUT)
        !            42:        D WR("DISPLAY GROUP:",$P(DDSFD(0),U,4)) Q:$D(DIRUT)
        !            43:        ;
        !            44:        D WR("UNIQUE NAME:",$P(DDSFD(0),U,5)) Q:$D(DIRUT)
        !            45:        ;
        !            46:        D WR("FIELD:",$P($G(^DIST(.404,DDSBK,40,DDSFD,1)),U)) Q:$D(DIRUT)
        !            47:        D WR("COMPUTED EXPRESSION:",$G(^DIST(.404,DDSBK,40,DDSFD,30))) Q:$D(DIRUT)
        !            48:        ;
        !            49:        I DDSFD(20)'?."^" D  Q:$D(DIRUT)
        !            50:        . D WR("READ TYPE:",$$EXTERNAL^DILFD(.4044,20.1,"",$P(DDSFD(20),U))) Q:$D(DIRUT)
        !            51:        . D WR("PARAMETERS:",$P(DDSFD(20),U,2)) Q:$D(DIRUT)
        !            52:        . D WR("QUALIFIERS:",$P(DDSFD(20),U,3)) Q:$D(DIRUT)
        !            53:        . ;
        !            54:        . S DDSWP=$NA(^DIST(.404,DDSBK,40,DDSFD,21))
        !            55:        . I $P($G(@DDSWP@(0)),U,3) D
        !            56:        .. D W("HELP:",DDSCOL2) Q:$D(DIRUT)
        !            57:        .. D WP^DDSPRNT(DDSWP,DDSCOL2+3,"B")
        !            58:        . K DDSWP Q:$D(DIRUT)
        !            59:        . ;
        !            60:        . D WR("INPUT TRANSFORM:",$G(^DIST(.404,DDSBK,40,DDSFD,22))) Q:$D(DIRUT)
        !            61:        . D WR("SAVE CODE:",$G(^DIST(.404,DDSBK,40,DDSFD,23))) Q:$D(DIRUT)
        !            62:        . D WR("SCREEN:",$G(^DIST(.404,DDSBK,40,DDSFD,24))) Q:$D(DIRUT)
        !            63:        . K DDSFD(20)
        !            64:        ;
        !            65:        D WR("CAPTION COORDINATE:",$P(DDSFD(2),U,3)) Q:$D(DIRUT)
        !            66:        D WR("DATA COORDINATE:",$P(DDSFD(2),U)) Q:$D(DIRUT)
        !            67:        D WR("DATA LENGTH:",$P(DDSFD(2),U,2)) Q:$D(DIRUT)
        !            68:        D WR("SUPPRESS COLON:",$S($P(DDSFD(2),U,4):"YES",1:"")) Q:$D(DIRUT)
        !            69:        ;
        !            70:        D WR("DEFAULT:",$P($G(^DIST(.404,DDSBK,40,DDSFD,3)),U)) Q:$D(DIRUT)
        !            71:        D WR("EXECUTABLE DEFAULT:",$G(^DIST(.404,DDSBK,40,DDSFD,3.1))) Q:$D(DIRUT)
        !            72:        ;
        !            73:        I DDSFD(4)'?."^" D
        !            74:        . D WR("REQUIRED:",$S($P(DDSFD(4),U):"YES",1:"")) Q:$D(DIRUT)
        !            75:        . D WR("DISABLE EDITING:",$S($P(DDSFD(4),U,4):"YES",1:"")) Q:$D(DIRUT)
        !            76:        . D WR("RIGHT JUSTIFY:",$S($P(DDSFD(4),U,3):"YES",1:"")) Q:$D(DIRUT)
        !            77:        . D WR("DISALLOW LAYGO:",$S($P(DDSFD(4),U,5):"YES",1:"")) Q:$D(DIRUT)
        !            78:        K DDSFD(4)
        !            79:        ;
        !            80:        D WR("SUB PAGE LINK:",$P($G(^DIST(.404,DDSBK,40,DDSFD,7)),U,2)) Q:$D(DIRUT)
        !            81:        ;
        !            82:        D WR("BRANCHING LOGIC:",$G(^DIST(.404,DDSBK,40,DDSFD,10))) Q:$D(DIRUT)
        !            83:        D WR("PRE ACTION:",$G(^DIST(.404,DDSBK,40,DDSFD,11))) Q:$D(DIRUT)
        !            84:        D WR("POST ACTION:",$G(^DIST(.404,DDSBK,40,DDSFD,12))) Q:$D(DIRUT)
        !            85:        D WR("POST ACTION ON CHANGE:",$G(^DIST(.404,DDSBK,40,DDSFD,13))) Q:$D(DIRUT)
        !            86:        D WR("DATA VALIDATION:",$G(^DIST(.404,DDSBK,40,DDSFD,14))) Q:$D(DIRUT)
        !            87:        ;
        !            88:        D W() Q:$D(DIRUT)
        !            89:        Q
        !            90:        ;
        !            91: WR(DDSLAB,DDSVAL,DDSFLG)       ;Write label and value
        !            92:        I DDSVAL="",'$G(DDSFLG) Q
        !            93:        ;
        !            94:        D W() Q:$D(DIRUT)
        !            95:        W ?DDSCOL2,DDSLAB
        !            96:        ;
        !            97:        I $X>DDSCOL3 N DDSCOL3 S DDSCOL3=$X+1
        !            98:        D PCOL(DDSVAL,DDSCOL3)
        !            99:        Q
        !           100:        ;
        !           101: PCOL(DDSVAL,DDSCOL)    ;Print DDSVAL starting in column DDSCOL
        !           102:        N DDSWIDTH,DDSIND
        !           103:        S DDSWIDTH=IOM-DDSCOL-1
        !           104:        F DDSIND=1:DDSWIDTH:$L(DDSVAL) D  Q:$D(DIRUT)
        !           105:        . I DDSIND>1 D W() Q:$D(DIRUT)
        !           106:        . W ?DDSCOL,$E(DDSVAL,DDSIND,DDSIND+DDSWIDTH-1)
        !           107:        Q
        !           108:        ;
        !           109: W(DDSSTR,DDSCOL)       ;Write DDSSTR preceded by !?DDSCOL
        !           110:        I $Y+3'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
        !           111:        W !?+$G(DDSCOL),$G(DDSSTR)
        !           112:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>