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

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1DDSPRNT ;SFISC/MKO-PRINT A FORM ;02:51 PM 18 Nov 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
6 ;
7 N DDSFORM,DDSPBRK
8 D SELFORM(.DDSFORM) Q:DDSFORM=-1
9 D PAGEBRK(.DDSPBRK) Q:$D(DDSPBRK)[0
10 ;
11 ;Device
12 S %ZIS=$S($D(^%ZTSK):"Q",1:"")
13 W ! D ^%ZIS K %ZIS I $G(POP) K POP Q
14 K POP
15 ;
16 ;Queue report
17 I $D(IO("Q")),$D(^%ZTSK) D G END
18 . S ZTRTN="PRINT^DDSPRNT"
19 . S ZTDESC="Report of Form "_$P(DDSFORM,U,2)
20 . N I F I="DDSFORM","DDSFORM(0)","DDSPBRK" S ZTSAVE(I)=""
21 . D ^%ZTLOAD
22 . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
23 . E W !,"Report canceled!",!
24 . K ZTSK
25 . S IOP="HOME" D ^%ZIS
26 ;
27 U IO
28 ;
29PRINT ;Entry point for queued reports
30 N DDSBK,DDSCOL1,DDSCOL2,DDSCOL3,DDSCRT,DDSFILE
31 N DDSHLIN,DDSHBK,DDSPAGE,DDSQUE
32 N DX,DY,X,Y
33 ;
34 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
35 D INIT
36 D @("HDR"_(2-DDSCRT))
37 D FORM,END
38 Q
39 ;
40FORM ;Form data
41 W !
42 ;
43 ;Description
44 D WP($NA(^DIST(.403,+DDSFORM,15))) Q:$D(DIRUT)
45 ;
46 ;Other properties
47 D W("PRIMARY FILE: "_$P(DDSFORM(0),U,8),9) Q:$D(DIRUT)
48 W ?49,"READ ACCESS: "_$P(DDSFORM(0),U,2)
49 D W("DATE CREATED: "_$$EXTERNAL^DILFD(.403,4,"",$P(DDSFORM(0),U,5)),9) Q:$D(DIRUT)
50 W ?48,"WRITE ACCESS: "_$P(DDSFORM(0),U,3)
51 D W("DATE LAST USED: "_$$EXTERNAL^DILFD(.403,5,"",$P(DDSFORM(0),U,6)),7) Q:$D(DIRUT)
52 W ?53,"CREATOR: "_$P(DDSFORM(0),U,4)
53 D W() Q:$D(DIRUT)
54 ;
55 I $P(DDSFORM(0),U,7)]"" D W("TITLE: "_$P(DDSFORM(0),U,7),16) Q:$D(DIRUT)
56 I $P($G(^DIST(.403,+DDSFORM,21)),U)]"" D W("RECORD SELECTION PAGE: "_$P(^(21),U)) Q:$D(DIRUT)
57 ;
58 I $X D W() Q:$D(DIRUT)
59 S X=$G(^DIST(.403,+DDSFORM,11))
60 I X]"" D W("PRE ACTION:",11) Q:$D(DIRUT) D PCOL(X,23)
61 S X=$G(^DIST(.403,+DDSFORM,12))
62 I X]"" D W("POST ACTION:",10) Q:$D(DIRUT) D PCOL(X,23)
63 S X=$G(^DIST(.403,+DDSFORM,14))
64 I X]"" D W("POST SAVE:",12) Q:$D(DIRUT) D PCOL(X,23)
65 S X=$G(^DIST(.403,+DDSFORM,20))
66 I X]"" D W("DATA VALIDATION:",6) Q:$D(DIRUT) D PCOL(X,23)
67 K DDSFORM(0)
68 ;
69 ;Loop through all pages
70 I $X D W() Q:$D(DIRUT)
71 Q:'$O(^DIST(.403,+DDSFORM,40,0))
72 ;
73 N DDSPG,DDSPGN
74 S DDSPGN="",DDSPFRST=1
75 F S DDSPGN=$O(^DIST(.403,+DDSFORM,40,"B",DDSPGN)) Q:DDSPGN=""!$D(DIRUT) S DDSPG=0 F S DDSPG=$O(^DIST(.403,+DDSFORM,40,"B",DDSPGN,DDSPG)) Q:'DDSPG!$D(DIRUT) D PAGE^DDSPRNT1
76 K DDSPFRST Q:$D(DIRUT)
77 ;
78 D:$D(DDSHBK) HBLKS^DDSPRNT1
79 Q
80 ;
81WR(DDSLAB,DDSVAL,DDSFLG) ;Write label and value
82 I DDSVAL="",'$G(DDSFLG) Q
83 ;
84 D W() Q:$D(DIRUT)
85 W ?DDSCOL2,DDSLAB
86 ;
87 I $X>DDSCOL3 N DDSCOL3 S DDSCOL3=$X+1
88 D PCOL(DDSVAL,DDSCOL3)
89 Q
90 ;
91PCOL(DDSVAL,DDSCOL) ;Print DDSVAL
92 N DDSWIDTH,DDSIND
93 S DDSWIDTH=IOM-DDSCOL-1
94 F DDSIND=1:DDSWIDTH:$L(DDSVAL) D Q:$D(DIRUT)
95 . I DDSIND>1 D W() Q:$D(DIRUT)
96 . W ?DDSCOL,$E(DDSVAL,DDSIND,DDSIND+DDSWIDTH-1)
97 Q
98 ;
99WP(DDSWP,DIWL,DDSLF) ;Print text in array @DDSWP
100 ;DDSLF [ A : LF after (def)
101 ; B : LF feed before
102 ;
103 Q:'$P($G(@DDSWP@(0)),U,3)
104 N DIW,DIWF,DIWI,DIWR,DIWT,DIWTC,DIWX,DN
105 N DDSI,DDSCNT,I,X,Z
106 ;
107 K ^UTILITY($J,"W")
108 S:'$G(DIWL) DIWL=1
109 S DIWR=IOM-1
110 S:'$D(DDSLF) DDSLF="A"
111 ;
112 S DDSCNT=$P($G(@DDSWP@(0)),U,3)
113 I DDSCNT D
114 . F DDSI=1:1:DDSCNT I $D(@DDSWP@(DDSI,0))#2 S X=^(0) D ^DIWP
115 . ;
116 . I DDSLF'["B" D
117 .. W ?DIWL-1,$G(^UTILITY($J,"W",DIWL,1,0))
118 .. S DDSCNT=1
119 . E S DDSCNT=0
120 . F S DDSCNT=$O(^UTILITY($J,"W",DIWL,DDSCNT)) Q:'DDSCNT!$D(DIRUT) D
121 .. D W($G(^UTILITY($J,"W",DIWL,DDSCNT,0)),DIWL-1)
122 ;
123 K ^UTILITY($J,"W")
124 D:DDSLF["A" W()
125 Q
126 ;
127W(DDSSTR,DDSCOL) ;Write DDSSTR
128 I $Y+3'<IOSL D HEADER Q:$D(DIRUT)
129 W !?+$G(DDSCOL),$G(DDSSTR)
130 Q
131 ;
132HEADER ;All headers except first
133 I DDSCRT D Q:$D(DIRUT)
134 . N DIR,X,Y
135 . S DIR(0)="E" W ! D ^DIR
136 I DDSQUE,$$S^%ZTLOAD S (ZTSTOP,DIRUT)=1 Q
137 ;
138HDR1 ;First header for CRTs
139 W @IOF
140 ;
141HDR2 ;First header for non-CRTs
142 ;
143 S DDSPAGE=$G(DDSPAGE)+1
144 W "FORM LISTING - "_$P(DDSFORM,U,2)_" (#"_+DDSFORM_")"
145 W !,"FILE: "_DDSFILE
146 W ?(IOM-$L(DDSHLIN)-$L(DDSPAGE)-1),DDSHLIN_DDSPAGE
147 W !,$TR($J("",IOM-1)," ","-")
148 Q
149 ;
150SELFORM(DDSFORM) ;Select form
151 N %,%W,%Y,C,I,Q,DDH,DIC,X,Y
152 S DIC="^DIST(.403,",DIC(0)="QEAMZ"
153 D ^DIC K DIC
154 S DDSFORM=Y,DDSFORM(0)=$G(Y(0))
155 Q
156 ;
157PAGEBRK(DDSPBRK) ;Prompt
158 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
159 S DIR(0)="YO"
160 S DIR("A")="Start each page of the form on a new page"
161 S DIR("B")="Yes"
162 W ! D ^DIR Q:$D(DIRUT)
163 S DDSPBRK=Y
164 Q
165 ;
166INIT ;Setup
167 N %,%H,X,Y
168 S %H=$H D YX^%DTC
169 S DDSHLIN=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)_" PAGE "
170 S DDSFILE=$P(DDSFORM(0),U,8)
171 I DDSFILE,$D(^DIC(DDSFILE,0))#2 S DDSFILE=$P(^(0),U)_" (#"_DDSFILE_")"
172 E S DDSFILE=""
173 S DDSCRT=$E(IOST,1,2)="C-"
174 S DDSQUE=$D(ZTQUEUED)
175 Q
176 ;
177END ;Finish up
178 I $D(ZTQUEUED) S ZTREQ="@"
179 E X $G(^%ZIS("C"))
180 K DIRUT,DUOUT,DTOUT
181 Q
Note: See TracBrowser for help on using the repository browser.