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

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

initial load of WorldVistAEHR

File size: 6.8 KB
RevLine 
[613]1DDMP2 ;SFISC/DPC-Import Device, Queuing, Reports ;11/5/97 08:10
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4DEV(DDMPIOIN,DDMPIOP) ;
5 ;Device selection for printed report.
6 ;DDMPIOIN might contain preselected info.
7 ;DDMPIOP will contain device data for later use with ^%ZIS.
8 I $D(DDMPIOIN("IOP")) D
9 . I $P(DDMPIOIN("IOP"),";")'="Q" S DDMPIOP=DDMPIOIN("IOP")
10 . E D
11 . . S DDMPIOP=$P(DDMPIOIN("IOP"),";",2,99),DDMPIOP("Q")=1
12 . . I $D(DDMPIOIN("QTIME")) D SETQTIME
13 E D
14 . N %ZIS,POP
15 . S %ZIS="QN"
16 . S %ZIS("A")="Device for Import Results Report: "
17 . D ^%ZIS
18 . I POP S DDMPIOP("NG")=1 Q
19 . I $E(IOST,1,2)="C-" S DDMPIOP("HOME")=1 Q
20 . D SETIOP
21 . I $G(IO("Q")) S DDMPIOP("Q")=1 Q
22 . D HOME^%ZIS
23 . I $P(DDMPIOP,";",2)="P-BROWSER" Q
24 . N DIR,DIRUT,Y
25 . S DIR(0)="Y"
26 . S DIR("A")="Do you want to queue this data import"
27 . D ^DIR
28 . I $G(DIRUT) S DDMPIOP("NG")=1 Q
29 . I Y S DDMPIOP("Q")=1
30 Q
31 ;
32SETIOP ;
33 ;Sets up IOP, etc., from variables returned by ^%ZIS.
34 S DDMPIOP=ION
35 I $G(IOST)]"" S DDMPIOP=DDMPIOP_";"_IOST
36 I $G(IO("DOC"))]"" S DDMPIOP=DDMPIOP_";"_IO("DOC") Q
37 I $G(IOM) S DDMPIOP=DDMPIOP_";"_IOM
38 I $G(IOSL) S DDMPIOP=DDMPIOP_";"_IOSL
39 I $G(IOT)="HFS" S DDMPIOP("HFSNAME")=IO,DDMPIOP("HFSMODE")="W"
40 Q
41 ;
42SETQTIME ;
43 ;Sets time for queuing from value passed in ("QTIME")
44 N X,Y,%DT
45 S X=DDMPIOIN("QTIME")
46 I X="NOW" S DDMPIOP("QTIME")=$H
47 E D
48 . I X'["@" S X="T@"_X
49 . S %DT="XT",%DT(0)="NOW"
50 . D ^%DT
51 . I Y<0 S DDMPIOP("NG")=1 Q
52 . S DDMPIOP("QTIME")=Y
53 Q
54 ;
55QUE(DDMPIOP) ;
56 ;Queues the import.
57 S ZTRTN="TASK^DDMP"
58 S ZTIO=""
59 S ZTDESC="Queued data import."
60 I $D(DDMPIOP("QTIME")) S ZTDTH=DDMPIOP("QTIME")
61 S ZTSAVE("^TMP($J,""DDMP"",")=""
62 S ZTSAVE("DDMPIOP(")=""
63 S ZTSAVE("DDMPIOP")=""
64 S ZTSAVE("DDMPF")=""
65 S ZTSAVE("DDMPSQ(")=""
66 S ZTSAVE("DDMPFMT(")=""
67 S ZTSAVE("DDMPFLG")=""
68 S ZTSAVE("DDMPFLG(")=""
69 S ZTSAVE("DDMPNCNT")=""
70 S ZTSAVE("DDMPFSRC(")=""
71 D ^%ZTLOAD
72 I $G(ZTSK) D
73 . W !,"Import queued. Task number: "_ZTSK
74 E W !,"Queuing of import failed. Import aborted."
75 Q
76 ;
77REP1(DDMPRPSB,DDMPLN) ;
78 N DDMPI,DDMPTXT,DDMPUSR,DDMPFNO,DDMPLEN
79 S DDMPLN=0
80 I '$D(^XTMP("DDMP1000")) S DDMPRPSB="DDMP1000"
81 E S DDMPRPSB="DDMP"_($P($O(^XTMP("DDMPz"),-1),"DDMP",2)+1)
82 S ^XTMP(DDMPRPSB,0)=DT_U_DT_U
83 S DDMPUSR=$$GET1^DIQ(200,DUZ_",",.01)
84 S ^(0)=^XTMP(DDMPRPSB,0)_"Import report: "_DDMPUSR
85 D LDXTMP($P($T(LN1+1),";;",2)_$P(DDMPUSR,",",2)_" "_$P(DDMPUSR,","))
86 D LDXTMP("")
87 D LDXTMP($P($T(LN1+2),";;",2)_DDMPFSRC("PATH")_DDMPFSRC("FILE"))
88 D LDXTMP($P($T(LN1+3),";;",2)_DDMPFMT("FIXED"))
89 D LDXTMP($P($T(LN1+4),";;",2)_DDMPFMT("FDELIM"))
90 D LDXTMP($P($T(LN1+5),";;",2)_DDMPFMT("QUOTED"))
91 D LDXTMP($P($T(LN1+6),";;",2)_$S(DDMPFLG["E":"External",1:"Internal"))
92 D LDXTMP("")
93 D LDXTMP($P($T(LN1+7),";;",2)_$$GET1^DID(DDMPF,"","","NAME"))
94 D LDXTMP("")
95 D LDXTMP($P($T(LN1+8),";;",2))
96 D LDXTMP($P($T(LN1+9),";;",2))
97 F DDMPI=1:1 Q:'$D(DDMPSQ(DDMPI)) D
98 . S DDMPFNO=$P(DDMPSQ(DDMPI),"~"),DDMPLEN=$P(DDMPSQ(DDMPI),"~",4)
99 . S DDMPTXT=DDMPI_$J("",5-$L(DDMPI))_$S(DDMPLEN:DDMPLEN,1:"n/a")
100 . S DDMPTXT=DDMPTXT_$J("",10-$L(DDMPTXT))_$$GET1^DID(DDMPFNO,$P(DDMPSQ(DDMPI),"~",3),"","LABEL")
101 . I DDMPF'=DDMPFNO S DDMPTXT=DDMPTXT_$J("",43-$L(DDMPTXT))_$O(^DD(DDMPFNO,0,"NM",""))
102 . D LDXTMP(DDMPTXT)
103 D LDXTMP("")
104 D LDXTMP("")
105 D LDXTMP($P($T(LN1+10),";;",2))
106 D LDXTMP($P($T(LN1+11),";;",2))
107 D LDXTMP("")
108 Q
109 ;
110LDXTMP(DDMPTXT) ;
111 S DDMPLN=DDMPLN+1
112 S ^XTMP(DDMPRPSB,DDMPLN)=DDMPTXT
113 Q
114 ;
115LN1 ;
116 ;; Import Initiated By:
117 ;; Source File:
118 ;; Fixed Length:
119 ;; Delimited By:
120 ;; Text Values Quoted:
121 ;; Values Are:
122 ;; Primary FileMan Destination File:
123 ;;Seq Len Field Name Subfile Name (if applicable)
124 ;;--- --- ---------- ----------------------------
125 ;; Error Report
126 ;; ------------
127 ;
128REP2(DDMPRPSB,DDMPLN,DDMPSTAT) ;
129 N POP
130 I '$G(DDMPSTAT("NG")) D LDXTMP($P($T(LN2+1),";;",2))
131 D LDXTMP("")
132 D LDXTMP("")
133 D LDXTMP($P($T(LN2+2),";;",2))
134 D LDXTMP($P($T(LN2+3),";;",2))
135 D LDXTMP("")
136 I $G(DDMPSTAT("ABORT")) D
137 . D LDXTMP($P($T(LN2+4),";;",2))
138 . D LDXTMP($P($T(LN2+(4+DDMPSTAT("ABORT"))),";;",2))
139 . D LDXTMP("")
140 D LDXTMP($P($T(LN2+7),";;",2)_DDMPSTAT("TOT"))
141 D LDXTMP($P($T(LN2+8),";;",2)_(DDMPSTAT("TOT")-DDMPSTAT("NG")))
142 D LDXTMP($P($T(LN2+9),";;",2)_DDMPSTAT("NG"))
143 D LDXTMP("")
144 D LDXTMP($P($T(LN2+10),";;",2)_$G(DDMPSTAT("FIEN"),"Nothing filed"))
145 D LDXTMP($P($T(LN2+11),";;",2)_$G(DDMPSTAT("LIEN"),"Nothing filed"))
146 D LDXTMP("")
147 D LDXTMP($P($T(LN2+12),";;",2)_$$HTE^DILIBF(DDMPSTAT("BEG")))
148 S DDMPSTAT("END")=$H
149 D LDXTMP($P($T(LN2+13),";;",2)_$$HTE^DILIBF(DDMPSTAT("END")))
150 D LDXTMP($P($T(LN2+14),";;",2)_$$HDIFF^DILIBF(DDMPSTAT("END"),DDMPSTAT("BEG"),3))
151 I $G(DDMPIOP("HOME")) W @IOF D PRNTHM Q
152 I $P($G(DDMPIOP),";",2)="P-BROWSER" D BROWSET Q:POP D PRNTHM Q
153 ;Set up queued job for report printing.
154 N %ZIS
155 S %ZIS="Q"
156 S IOP="Q;"_DDMPIOP
157 I $D(DDMPIOP("HFSNAME")) S %ZIS("HFSNAME")=DDMPIOP("HFSNAME")
158 I $D(DDMPIOP("HFSNODE")) S %ZIS("HFSMODE")=DDMPIOP("HFSMODE")
159 D ^%ZIS
160 I POP Q ;ERROR THAT REPORT CANNOT PRINT
161 K ZTIO
162 S ZTRTN="PRNT^DDMP2"
163 S ZTSAVE("DDMPRPSB")=""
164 S ZTDTH=$H
165 S ZTDESC="Printing of Import Log for User# "_DUZ
166 D ^%ZTLOAD
167 I '$D(ZTQUEUED) W !,"Task Number for printing: "_ZTSK
168 Q
169PRNT ;
170 ;Tasked print of report.
171 S ZTREQ="@"
172 U IO
173PRNTHM ;Print to home device. Tasked prints fall through.
174 N DDMPCNT,DDMPPG,DDMPIOSL,DDMPOUT
175 S DDMPIOSL=$G(IOSL,60)
176 S DDMPPG=0,DDMPCNT=0
177 D HDR
178 F S DDMPCNT=$O(^XTMP(DDMPRPSB,DDMPCNT)) Q:DDMPCNT="" D Q:$G(DDMPOUT)
179 . W !,^XTMP(DDMPRPSB,DDMPCNT)
180 . I $Y+3>DDMPIOSL D HDR
181 I $E(IOST,1,2)'="C-" W @IOF D ^%ZISC
182 Q
183 ;
184BROWSET ;
185 N %ZIS
186 S IOP=DDMPIOP
187 D ^%ZIS
188 U IO
189 Q
190 ;
191HDR ;
192 I DDMPPG,$E(IOST,1,2)="C-" N DIR,Y S DIR(0)="E" D ^DIR I 'Y S DDMPOUT=1 Q
193 I DDMPPG W @IOF
194 S DDMPPG=DDMPPG+1
195 W $P($T(HDR1+1),";;",2)_DDMPPG
196 W !,$P($T(HDR1+2),";;",2)
197 W !
198 Q
199 ;
200HDR1 ;
201 ;; Log for VA FileMan Data Import Page
202 ;; ==============================
203LN2 ;
204 ;; No errors occured during this data import.
205 ;; Summary of Import
206 ;; -----------------
207 ;; <<<IMPORT NOT COMPLETED:
208 ;; MAXIMUM ERRORS DETECTED>>>
209 ;; USER ABORT OF TASKED IMPORT>>>
210 ;; Total Records Read:
211 ;; Total Records Filed:
212 ;; Total Records Rejected:
213 ;; IEN of First Record Filed:
214 ;; IEN of Last Record Filed:
215 ;; Import Filing Started:
216 ;; Import Filing Completed:
217 ;; Time of Import Filing:
Note: See TracBrowser for help on using the repository browser.