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

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1DDMP ;SFISC/DPC-IMPORT ASCII DATA ;9/23/96 14:58
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FILE(DDMPF,DDMPFLDS,DDMPFLG,DDMPFSRC,DDMPFMT) ;
5 ;API for import tool.
6 ;DDMPF - file# of primary import file.
7 ;DDMPFLDS (by ref or value) - 1) name of import template (in [])
8 ; 2) ;-delimited fields array. Primary file in top element.
9 ; Other nodes subscripted by subfile#.
10 ;DDMPFLG (by ref.) - ("FLAGS"): 'E'xternal; 'F'ile contains specs
11 ; ("MSGS"): Root to contain error messages.
12 ; ("MAXERR"): Maximum # of errors allowed.
13 ; ("IOP"): Device for report printing.
14 ; ("QTIME"): Queue import time.
15 ;DDMPFSRC (by ref.) -("PATH"): Path to source file
16 ; ("FILE"): Source file name.
17 ;DDMPFMT (by value or ref.) - 1) top node = foreign format.
18 ; 2) ("FDELIM"): Field delimiter.
19 ; ("FIXED"): YES if fixed format.
20 ; ("QUOTED"): YES if delimited fields quoted.
21 ;
22 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
23 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
24 N DDMPNCNT
25 S DDMPFLG=$G(DDMPFLG("FLAGS"),$G(DDMPFLG)) I '$$VERFLG^DIEFU(DDMPFLG,"FE") G OUT
26 S DDMPFLG("MAXERR")=$G(DDMPFLG("MAXERR"),1000)
27 S DDMPFSRC("PATH")=$G(DDMPFSRC("PATH"))
28 I $G(DDMPFSRC("FILE"))="" D BLD^DIALOG(202,"host source file","host source file") G OUT
29 D GETFMT^DDMP1(.DDMPFMT) G:$G(DIERR) OUT
30 D GETSRC^DDMP1(.DDMPFSRC) G:'$D(^TMP($J,"DDMP")) OUT
31 S DDMPNCNT=$O(^TMP($J,"DDMP",""))
32 I DDMPFLG["F" D G:$G(DIERR) OUT
33 . I $G(DDMPF)'=""!($D(DDMPFLDS)&($G(DDMPFLDS)'="")) D BLD^DIALOG(1833) Q
34 . D INFILE^DDMP1("^TMP($J,""DDMP"")",.DDMPFMT,.DDMPF,.DDMPFLDS,.DDMPNCNT)
35 E I $G(DDMPF)=""!('$D(DDMPFLDS)) D BLD^DIALOG(202,"file or the fields","file or the fields") G OUT
36 I DDMPNCNT="" D BLD^DIALOG(1812,DDMPFSRC("FILE"),DDMPFSRC("FILE")) G OUT
37 I $E($G(DDMPFLDS))="[" N DDMPERR D G:DDMPERR'=$G(DIERR) OUT ;import template processing
38 . S DDMPERR=$G(DIERR)
39 . D TMPL2DR^DDMP1(DDMPF,.DDMPFLDS)
40 S DDMPFLDS(DDMPF)=$G(DDMPFLDS(DDMPF),$G(DDMPFLDS))
41 I '$$RQIDOK^DDMP1(.DDMPFLDS) G OUT
42 N DDMPSQ,DDMPFIEN S (DDMPSQ,DDMPFIEN)=0
43 D FLDBLD(DDMPF,.DDMPFLDS,.DDMPSQ,.DDMPFIEN,1) G:$G(DIERR) OUT
44 N DDMPIOP,ZTSK,POP ;Device and queuing setup.
45 D DEV^DDMP2(.DDMPFLG,.DDMPIOP)
46 I $G(DDMPIOP("NG")) D BLD^DIALOG(1850) G OUT
47 I $G(DDMPIOP("Q")) D QUE^DDMP2(.DDMPIOP) G OUT
48TASK ;Entry point for queued imports. If not queued, processing continues.
49 N DDMPRPSB,DDMPLN,DDMPSTAT,POP
50 D REP1^DDMP2(.DDMPRPSB,.DDMPLN)
51 S DDMPSTAT("BEG")=$H,(DDMPSTAT("TOT"),DDMPSTAT("NG"))=0
52 D PUTDRVR(.DDMPSQ,.DDMPFMT,.DDMPFLG,DDMPNCNT,.DDMPSTAT)
53 D REP2^DDMP2(DDMPRPSB,DDMPLN,.DDMPSTAT)
54OUT I $D(ZTQUEUED) D
55 . S ZTREQ="@"
56 . D CLEAN^DIEFU
57 E I $G(DDMPFLG("MSGS"))]"" D CALLOUT^DIEFU(DDMPFLG("MSGS"))
58 K ^TMP($J,"DDMP")
59 ;K ^XTMP(DDMPRPSB) ;Deletes the report from XTMP
60 Q
61 ;
62FLDBLD(DDMPF,DDMPFLDS,DDMPSQ,DDMPFIEN,DDMPTFIX) ;
63 N DDMPI,DDMPNFLD,DDMPNIEN,DDMPINFD
64 S DDMPFIEN=DDMPFIEN+1
65 S DDMPNIEN="+"_DDMPFIEN_","_$G(DDMPFIEN("UP",DDMPF))
66 F DDMPI=1:1 S DDMPINFD=$P(DDMPFLDS(DDMPF),";",DDMPI) Q:DDMPINFD="" D Q:$G(DIERR)
67 . I DDMPINFD'["[" S DDMPNFLD=DDMPINFD
68 . E N DDMPOFIX S DDMPNFLD=+DDMPINFD,DDMPOFIX=$P($P(DDMPINFD,"]"),"[",2)
69 . I '$$VFIELD^DIEFU(DDMPF,DDMPNFLD,"D") Q
70 . N DDMP0P2
71 . S DDMP0P2=$P($G(^DD(DDMPF,DDMPNFLD,0)),U,2)
72 . I +DDMP0P2 D Q
73 . . N DDMPDWF
74 . . I $P($G(^DD(+DDMP0P2,.01,0)),U,2)["W" D Q
75 . . . N DDMPE S DDMPE(1)="word processing",DDMPE("FILE")=DDMPF,DDMPE("FIELD")=DDMPNFLD
76 . . . D BLD^DIALOG(520,"word processing",.DDMPE)
77 . . S DDMPDWF=+DDMP0P2
78 . . S DDMPFIEN("UP",DDMPDWF)=DDMPNIEN
79 . . I '$D(DDMPFLDS(DDMPDWF)) D Q
80 . . . N DDMPP S DDMPP("FILE")=DDMPDWF
81 . . . D BLD^DIALOG(525,.DDMPP,.DDMPP)
82 . . D FLDBLD(DDMPDWF,.DDMPFLDS,.DDMPSQ,.DDMPFIEN,DDMPTFIX)
83 . S DDMPSQ=DDMPSQ+1
84 . I DDMPFMT("FIXED")="YES",'$G(DDMPOFIX) D BLD^DIALOG(1822)
85 . S DDMPSQ(DDMPSQ)=DDMPF_"~"_DDMPNIEN_"~"_DDMPNFLD_"~"_$G(DDMPOFIX)
86 Q
87 ;
88PUTDRVR(DDMPSQ,DDMPFMT,DDMPFLG,DDMPNODE,DDMPSTAT) ;
89 ;Sets up FDA and files data.
90 ;DDMPSQ (by reference): Contains specs for each field.
91 ;DDMPFMT (by reference): Format of imcoming data
92 ;DDMPFLG (by reference): Import control info.
93 ;DDMPNODE (by value): Number of first node containing data.
94 N DDMPTPAR,DDMPNDCT,DDMPUPFG,DDMPREF
95 I DDMPFLG["E" S DDMPUPFG="E"
96 S DDMPNDCT=1
97 S DDMPREF=$NA(^TMP($J,"DDMP",DDMPNODE))
98 S DDMPTPAR(1)=^TMP($J,"DDMP",DDMPNODE)
99 F S DDMPREF=$Q(@DDMPREF) Q:DDMPREF'[($J_",""DDMP""") D Q:$G(DDMPSTAT("ABORT"))
100 . I DDMPREF'["OVF" D
101 . . D RECPROC
102 . . K DDMPTPAR S DDMPNDCT=0
103 . S DDMPNDCT=DDMPNDCT+1
104 . S DDMPTPAR(DDMPNDCT)=@DDMPREF
105 I $G(DDMPSTAT("ABORT")) Q
106 D RECPROC
107 Q
108 ;
109RECPROC ; Files a record from DDMPTPAR()
110 N DDMPIENS
111 K ^TMP($J,"DDMPFDA")
112 D TOT(.DDMPSTAT) Q:$G(DDMPSTAT("ABORT"))
113 D PARSE(.DDMPSQ,.DDMPTPAR,DDMPNDCT)
114 I '$D(^TMP($J,"DDMPFDA")) D RECERR Q
115 D UPDATE^DIE($G(DDMPUPFG),"^TMP($J,""DDMPFDA"")","DDMPIENS")
116 I $G(DIERR) D
117 . D RECERR
118 E I DDMPSTAT("TOT")-DDMPSTAT("NG")>1 S DDMPSTAT("LIEN")=DDMPIENS(1)
119 E S (DDMPSTAT("FIEN"),DDMPSTAT("LIEN"))=DDMPIENS(1)
120 Q
121 ;
122TOT(DDMPSTAT) ;
123 S DDMPSTAT("TOT")=DDMPSTAT("TOT")+1
124 I '$D(ZTQUEUED) W "."
125 E I DDMPSTAT("TOT")#10=0,$$S^%ZTLOAD D
126 . S DDMPSTAT("ABORT")=2
127 . S ZTSTOP=1
128 Q
129 ;
130RECERR ;
131 N DDMPERLN,DDMPERR
132 S DDMPSTAT("NG")=DDMPSTAT("NG")+1
133 D LDXTMP^DDMP2("Record #"_DDMPSTAT("TOT")_" Rejected:")
134 D MSG^DIALOG("AEB",.DDMPERR,$S($D(IOM):IOM-5,1:75))
135 S DDMPERLN=0
136 F S DDMPERLN=$O(DDMPERR(DDMPERLN)) Q:'DDMPERLN D LDXTMP^DDMP2(" "_DDMPERR(DDMPERLN))
137 D CLEAN^DIEFU
138 I DDMPSTAT("NG")'<DDMPFLG("MAXERR") S DDMPSTAT("ABORT")=1
139 Q
140 ;
141PARSE(DDMPSQ,DDMPTPAR,DDMPNDCT) ;
142 N DDMPQ,DDMPHOLD,DDMPIN,DDMPI,DDMPTVAL,DDMPVAL
143 I DDMPTPAR(1)="" D BLD^DIALOG(1860) Q
144 S DDMPQ="""",DDMPSQ=0
145 F DDMPI=1:1:DDMPNDCT S DDMPIN=DDMPTPAR(DDMPI) F Q:DDMPIN=""!($G(DIERR)) D
146 . I $G(DDMPFMT("QUOTED"))="YES",($E(DDMPIN)=DDMPQ!($E($G(DDMPHOLD))=DDMPQ)) D
147 . . I $G(DDMPHOLD)]"" D
148 . . . I DDMPHOLD'=DDMPQ,$E(DDMPHOLD,$L(DDMPHOLD))=DDMPQ D
149 . . . . S DDMPVAL=DDMPHOLD,DDMPHOLD=""
150 . . . . S DDMPIN=$P(DDMPIN,DDMPFMT("FDELIM"),2,99)
151 . . . E D
152 . . . . S DDMPVAL=DDMPHOLD_$P(DDMPIN,DDMPQ)_DDMPQ,DDMPHOLD=""
153 . . . . S DDMPIN=$P($P(DDMPIN,DDMPQ,2,99),DDMPFMT("FDELIM"),2,99)
154 . . E D
155 . . . S DDMPTVAL=$P(DDMPIN,DDMPQ,1,2)_$S($L(DDMPIN,DDMPQ)>2:DDMPQ,1:"")
156 . . . S DDMPIN=$P(DDMPIN,DDMPTVAL,2)
157 . . . I DDMPIN=DDMPFMT("FDELIM") S DDMPIN="",DDMPVAL=DDMPTVAL Q
158 . . . S DDMPIN=$P(DDMPIN,DDMPFMT("FDELIM"),2,99)
159 . . . I DDMPIN="",DDMPI'=DDMPNDCT S DDMPHOLD=DDMPTVAL Q
160 . . . S DDMPVAL=DDMPTVAL
161 . E I $G(DDMPFMT("FDELIM"))'="" D
162 . . S DDMPTVAL=$P(DDMPIN,DDMPFMT("FDELIM"))
163 . . I $L(DDMPIN,DDMPFMT("FDELIM"))=2,$P(DDMPIN,DDMPFMT("FDELIM"),2)="" S DDMPIN="",DDMPVAL=$G(DDMPHOLD)_DDMPTVAL,DDMPHOLD="" Q
164 . . S DDMPIN=$P(DDMPIN,DDMPFMT("FDELIM"),2,99)
165 . . I $G(DDMPHOLD)]"" S DDMPVAL=DDMPHOLD_DDMPTVAL,DDMPHOLD="" Q
166 . . I DDMPIN="",DDMPI'=DDMPNDCT S DDMPHOLD=DDMPTVAL Q
167 . . S DDMPVAL=DDMPTVAL
168 . E D
169 . . N DDMPLEN,DDMPLAST
170 . . I '$D(DDMPSQ(DDMPSQ+1)) D BLD^DIALOG(1862) Q
171 . . S DDMPLEN=$P(DDMPSQ(DDMPSQ+1),"~",4)
172 . . I $G(DDMPHOLD)]"" D
173 . . . S DDMPVAL=DDMPHOLD_$E(DDMPIN,1,DDMPLEN-$L(DDMPHOLD))
174 . . . S DDMPIN=$E(DDMPIN,DDMPLEN-$L(DDMPHOLD)+1,255)
175 . . . S DDMPHOLD=""
176 . . E D
177 . . . S DDMPTVAL=$E(DDMPIN,1,DDMPLEN)
178 . . . S DDMPIN=$E(DDMPIN,DDMPLEN+1,255)
179 . . . I DDMPIN="",DDMPI'=DDMPNDCT S DDMPHOLD=DDMPTVAL Q
180 . . . S DDMPVAL=DDMPTVAL
181 . . I $D(DDMPVAL) F S DDMPLAST=$L(DDMPVAL) Q:$E(DDMPVAL,DDMPLAST)'=" " S DDMPVAL=$E(DDMPVAL,1,DDMPLAST-1)
182 . I $D(DDMPVAL) D K DDMPVAL
183 . . S DDMPSQ=DDMPSQ+1
184 . . I '$D(DDMPSQ(DDMPSQ)) D BLD^DIALOG(1862) Q
185 . . I $G(DDMPFMT("QUOTED"))="YES" S DDMPVAL=$TR(DDMPVAL,DDMPQ)
186 . . D FDASET(DDMPVAL,DDMPSQ(DDMPSQ))
187 I $G(DDMPFMT("FIXED"))="YES" F DDMPSQ=DDMPSQ+1:1 Q:'$D(DDMPSQ(DDMPSQ)) S DDMPVAL="" D FDASET(DDMPVAL,DDMPSQ(DDMPSQ))
188 Q
189 ;
190FDASET(DDMPVAL,DDMPSPEC) ;
191 S ^TMP($J,"DDMPFDA",$P(DDMPSPEC,"~"),$P(DDMPSPEC,"~",2),$P(DDMPSPEC,"~",3))=DDMPVAL
192 Q
193 ;
Note: See TracBrowser for help on using the repository browser.