Return to DDSPRNT2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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