Annotation of freem_fileman/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>