Annotation of freem_fileman/DDSPRNT.m, revision 1.1.1.1
1.1 snw 1: DDSPRNT ;SFISC/MKO-PRINT A FORM ;02:51 PM 18 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: 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: ;
29: PRINT ;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: ;
40: FORM ;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: ;
81: WR(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: ;
91: PCOL(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: ;
99: WP(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: ;
127: W(DDSSTR,DDSCOL) ;Write DDSSTR
128: I $Y+3'<IOSL D HEADER Q:$D(DIRUT)
129: W !?+$G(DDSCOL),$G(DDSSTR)
130: Q
131: ;
132: HEADER ;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: ;
138: HDR1 ;First header for CRTs
139: W @IOF
140: ;
141: HDR2 ;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: ;
150: SELFORM(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: ;
157: PAGEBRK(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: ;
166: INIT ;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: ;
177: END ;Finish up
178: I $D(ZTQUEUED) S ZTREQ="@"
179: E X $G(^%ZIS("C"))
180: K DIRUT,DUOUT,DTOUT
181: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSPRNT.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman