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

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1DDSPRNT1 ;SFISC/MKO-PRINT A FORM ;11:49 AM 17 Nov 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PAGE ;Print page properties
6 I $Y+7'<IOSL!(DDSPBRK&'$D(DDSPFRST)) D HEADER^DDSPRNT Q:$D(DIRUT)
7 I DDSPBRK!$D(DDSPFRST) D
8 . W !,"Page Page"
9 . W !,"Number Properties"
10 . W !,"------ ----------"
11 K DDSPFRST
12 ;
13 S DDSCOL1=0,DDSCOL2=8,DDSCOL3=32
14 F X=0,1 S DDSPG(X)=$G(^DIST(.403,+DDSFORM,40,DDSPG,X))
15 Q:DDSPG(0)=""
16 ;
17 D W() Q:$D(DIRUT)
18 W ?DDSCOL1,$P(DDSPG(0),U),?DDSCOL2,$P(DDSPG(1),U)
19 ;
20 D W() Q:$D(DIRUT)
21 D WP^DDSPRNT($NA(^DIST(.403,+DDSFORM,40,DDSPG,15)),DDSCOL2+1)
22 Q:$D(DIRUT)
23 ;
24 S X=$P(DDSPG(0),U,2)
25 I X]"" D Q:$D(DIRUT)
26 . D WR("HEADER BLOCK:",$P($G(^DIST(.404,X,0)),U)_" (#"_X_")")
27 . S DDSHBK(X)=""
28 ;
29 D WR("PAGE COORDINATE:",$P(DDSPG(0),U,3)) Q:$D(DIRUT)
30 I $P(DDSPG(0),U,6) D WR("IS THIS A POP UP PAGE?:","YES") Q:$D(DIRUT)
31 D WR("LOWER RIGHT COORDINATE:",$P(DDSPG(0),U,7)) Q:$D(DIRUT)
32 ;
33 D WR("NEXT PAGE:",$P(DDSPG(0),U,4)) Q:$D(DIRUT)
34 D WR("PREVIOUS PAGE:",$P(DDSPG(0),U,5)) Q:$D(DIRUT)
35 D WR("PARENT FIELD:",$P(DDSPG(1),U,2)) Q:$D(DIRUT)
36 ;
37 D WR("PRE ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,11))) Q:$D(DIRUT)
38 D WR("POST ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,12))) Q:$D(DIRUT)
39 K DDSPG(0),DDSPG(1)
40 ;
41 ;Loop through all blocks
42 I $X D W() Q:$D(DIRUT)
43 Q:'$O(^DIST(.403,+DDSFORM,40,DDSPG,40,0))
44 ;
45 I $Y+7'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
46 W !?DDSCOL2,"Block Block"
47 W !?DDSCOL2,"Order Properties (Form File)"
48 W !?DDSCOL2,"----- ----------------------"
49 ;
50 N DDSBKO
51 S DDSBKO=""
52 F S DDSBKO=$O(^DIST(.403,+DDSFORM,40,DDSPG,40,"AC",DDSBKO)) Q:DDSBKO=""!$D(DIRUT) S DDSBK=0 F S DDSBK=$O(^DIST(.403,+DDSFORM,40,DDSPG,40,"AC",DDSBKO,DDSBK)) Q:'DDSBK!$D(DIRUT) D BLOCK
53 Q
54 ;
55BLOCK ;Print Block properties
56 S DDSCOL1=8,DDSCOL2=15,DDSCOL3=39
57 F X=0,1,2 S DDSBK(X)=$G(^DIST(.403,+DDSFORM,40,DDSPG,40,DDSBK,X))
58 Q:DDSBK(0)=""
59 ;
60 D W($P(DDSBK(0),U,2),DDSCOL1) Q:$D(DIRUT)
61 W ?DDSCOL2,$P($G(^DIST(.404,DDSBK,0)),U)_" (#"_DDSBK_")"
62 D W() Q:$D(DIRUT)
63 ;
64 D WR("TYPE OF BLOCK:",$$EXTERNAL^DILFD(.4032,3,"",$P(DDSBK(0),U,4))) Q:$D(DIRUT)
65 D WR("BLOCK COORDINATE:",$P(DDSBK(0),U,3)) Q:$D(DIRUT)
66 D WR("POINTER LINK:",$P(DDSBK(1),U)) Q:$D(DIRUT)
67 D WR("REPLICATION:",$P(DDSBK(2),U)) Q:$D(DIRUT)
68 D WR("INDEX:",$P(DDSBK(2),U,2)) Q:$D(DIRUT)
69 D WR("INITIAL POSITION:",$P(DDSBK(2),U,3)) Q:$D(DIRUT)
70 D WR("DISALLOW LAYGO",$P(DDSBK(2),U,4)) Q:$D(DIRUT)
71 D WR("FIELD FOR SELECTION:",$P(DDSBK(2),U,5)) Q:$D(DIRUT)
72 ;
73 D WR("PRE ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,40,DDSBK,11))) Q:$D(DIRUT)
74 D WR("POST ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,40,DDSBK,12))) Q:$D(DIRUT)
75 ;
76 K DDSBK(1),DDSBK(2)
77 S DDSBK(0)=$G(^DIST(.404,DDSBK,0)) Q:DDSBK(0)=""
78 ;
79 I $Y+6'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
80 W !!?DDSCOL2,"Block Properties (Block File)"
81 W !,?DDSCOL2,"-----------------------------"
82 D BLOCK^DDSPRNT2
83 Q
84 ;
85HBLKS ;Header blocks
86 Q:'$D(DDSHBK)
87 I $Y+7'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
88 W !!,"Header Block Properties"
89 W !,"------------------------"
90 S DDSCOL1=8,DDSCOL2=15,DDSCOL3=39
91 S DDSBK="" F S DDSBK=$O(DDSHBK(DDSBK)) Q:'DDSBK!$D(DIRUT) D
92 . S DDSBK(0)=$G(^DIST(.404,DDSBK,0)) Q:DDSBK(0)=""
93 . D W("NAME: "_$P(DDSBK(0),U)_" (#"_DDSBK_")") Q:$D(DIRUT)
94 . D W() Q:$D(DIRUT)
95 . D BLOCK^DDSPRNT2
96 . D W() Q:$D(DIRUT)
97 Q
98 ;
99WR(DDSLAB,DDSVAL,DDSFLG) ;Write label and value
100 I DDSVAL="",'$G(DDSFLG) Q
101 ;
102 D W() Q:$D(DIRUT)
103 W ?DDSCOL2,DDSLAB
104 ;
105 I $X>DDSCOL3 N DDSCOL3 S DDSCOL3=$X+1
106 D PCOL(DDSVAL,DDSCOL3)
107 Q
108 ;
109PCOL(DDSVAL,DDSCOL) ;Print DDSVAL starting in column DDSCOL
110 N DDSWIDTH,DDSIND
111 S DDSWIDTH=IOM-DDSCOL-1
112 F DDSIND=1:DDSWIDTH:$L(DDSVAL) D Q:$D(DIRUT)
113 . I DDSIND>1 D W() Q:$D(DIRUT)
114 . W ?DDSCOL,$E(DDSVAL,DDSIND,DDSIND+DDSWIDTH-1)
115 Q
116 ;
117W(DDSSTR,DDSCOL) ;Write DDSSTR preceded by !?DDSCOL
118 I $Y+3'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
119 W !?+$G(DDSCOL),$G(DDSSTR)
120 Q
Note: See TracBrowser for help on using the repository browser.