source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSPRNT2.m@ 1696

Last change on this file since 1696 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.9 KB
Line 
1DDSPRNT2 ;SFISC/MKO-PRINT A FORM ;10:52 AM 23 Aug 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLOCK ;Print Block properties from Block file
6 D WP^DDSPRNT($NA(^DIST(.404,DDSBK,15)),DDSCOL2+1,"AB") 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(.404,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 ;
31FIELD ;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 ;
91WR(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 ;
101PCOL(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 ;
109W(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
Note: See TracBrowser for help on using the repository browser.