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

DDMP ;SFISC/DPC-IMPORT ASCII DATA ;9/23/96  14:58
 ;;22.0;VA FileMan;;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
FILE(DDMPF,DDMPFLDS,DDMPFLG,DDMPFSRC,DDMPFMT) ;
 ;API for import tool.
 ;DDMPF - file# of primary import file.
 ;DDMPFLDS (by ref or value) - 1) name of import template (in [])
 ;         2) ;-delimited fields array. Primary file in top element.
 ;            Other nodes subscripted by subfile#.
 ;DDMPFLG (by ref.) - ("FLAGS"): 'E'xternal; 'F'ile contains specs
 ;                    ("MSGS"): Root to contain error messages.
 ;                    ("MAXERR"): Maximum # of errors allowed.
 ;                    ("IOP"): Device for report printing.
 ;                    ("QTIME"): Queue import time.
 ;DDMPFSRC (by ref.) -("PATH"): Path to source file
 ;                    ("FILE"): Source file name.
 ;DDMPFMT (by value or ref.) - 1) top node = foreign format.
 ;          2) ("FDELIM"):  Field delimiter.
 ;             ("FIXED"): YES if fixed format.
 ;             ("QUOTED"): YES if delimited fields quoted.
 ;
 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
 N DDMPNCNT
 S DDMPFLG=$G(DDMPFLG("FLAGS"),$G(DDMPFLG)) I '$$VERFLG^DIEFU(DDMPFLG,"FE") G OUT
 S DDMPFLG("MAXERR")=$G(DDMPFLG("MAXERR"),1000)
 S DDMPFSRC("PATH")=$G(DDMPFSRC("PATH"))
 I $G(DDMPFSRC("FILE"))="" D BLD^DIALOG(202,"host source file","host source file") G OUT
 D GETFMT^DDMP1(.DDMPFMT) G:$G(DIERR) OUT
 D GETSRC^DDMP1(.DDMPFSRC) G:'$D(^TMP($J,"DDMP")) OUT
 S DDMPNCNT=$O(^TMP($J,"DDMP",""))
 I DDMPFLG["F" D  G:$G(DIERR) OUT
 . I $G(DDMPF)'=""!($D(DDMPFLDS)&($G(DDMPFLDS)'="")) D BLD^DIALOG(1833) Q
 . D INFILE^DDMP1("^TMP($J,""DDMP"")",.DDMPFMT,.DDMPF,.DDMPFLDS,.DDMPNCNT)
 E  I $G(DDMPF)=""!('$D(DDMPFLDS)) D BLD^DIALOG(202,"file or the fields","file or the fields") G OUT
 I DDMPNCNT="" D BLD^DIALOG(1812,DDMPFSRC("FILE"),DDMPFSRC("FILE")) G OUT
 I $E($G(DDMPFLDS))="[" N DDMPERR D  G:DDMPERR'=$G(DIERR) OUT ;import template processing
 . S DDMPERR=$G(DIERR)
 . D TMPL2DR^DDMP1(DDMPF,.DDMPFLDS)
 S DDMPFLDS(DDMPF)=$G(DDMPFLDS(DDMPF),$G(DDMPFLDS))
 I '$$RQIDOK^DDMP1(.DDMPFLDS) G OUT
 N DDMPSQ,DDMPFIEN S (DDMPSQ,DDMPFIEN)=0
 D FLDBLD(DDMPF,.DDMPFLDS,.DDMPSQ,.DDMPFIEN,1) G:$G(DIERR) OUT
 N DDMPIOP,ZTSK,POP ;Device and queuing setup.
 D DEV^DDMP2(.DDMPFLG,.DDMPIOP)
 I $G(DDMPIOP("NG")) D BLD^DIALOG(1850) G OUT
 I $G(DDMPIOP("Q")) D QUE^DDMP2(.DDMPIOP) G OUT
TASK ;Entry point for queued imports.  If not queued, processing continues.
 N DDMPRPSB,DDMPLN,DDMPSTAT,POP
 D REP1^DDMP2(.DDMPRPSB,.DDMPLN)
 S DDMPSTAT("BEG")=$H,(DDMPSTAT("TOT"),DDMPSTAT("NG"))=0
 D PUTDRVR(.DDMPSQ,.DDMPFMT,.DDMPFLG,DDMPNCNT,.DDMPSTAT)
 D REP2^DDMP2(DDMPRPSB,DDMPLN,.DDMPSTAT)
OUT I $D(ZTQUEUED) D
 . S ZTREQ="@"
 . D CLEAN^DIEFU
 E  I $G(DDMPFLG("MSGS"))]"" D CALLOUT^DIEFU(DDMPFLG("MSGS"))
 K ^TMP($J,"DDMP")
 ;K ^XTMP(DDMPRPSB) ;Deletes the report from XTMP
 Q
 ;
FLDBLD(DDMPF,DDMPFLDS,DDMPSQ,DDMPFIEN,DDMPTFIX) ;
 N DDMPI,DDMPNFLD,DDMPNIEN,DDMPINFD
 S DDMPFIEN=DDMPFIEN+1
 S DDMPNIEN="+"_DDMPFIEN_","_$G(DDMPFIEN("UP",DDMPF))
 F DDMPI=1:1 S DDMPINFD=$P(DDMPFLDS(DDMPF),";",DDMPI) Q:DDMPINFD=""  D  Q:$G(DIERR)
 . I DDMPINFD'["[" S DDMPNFLD=DDMPINFD
 . E  N DDMPOFIX S DDMPNFLD=+DDMPINFD,DDMPOFIX=$P($P(DDMPINFD,"]"),"[",2)
 . I '$$VFIELD^DIEFU(DDMPF,DDMPNFLD,"D") Q
 . N DDMP0P2
 . S DDMP0P2=$P($G(^DD(DDMPF,DDMPNFLD,0)),U,2)
 . I +DDMP0P2 D  Q
 . . N DDMPDWF
 . . I $P($G(^DD(+DDMP0P2,.01,0)),U,2)["W" D  Q
 . . . N DDMPE S DDMPE(1)="word processing",DDMPE("FILE")=DDMPF,DDMPE("FIELD")=DDMPNFLD
 . . . D BLD^DIALOG(520,"word processing",.DDMPE)
 . . S DDMPDWF=+DDMP0P2
 . . S DDMPFIEN("UP",DDMPDWF)=DDMPNIEN
 . . I '$D(DDMPFLDS(DDMPDWF)) D  Q
 . . . N DDMPP S DDMPP("FILE")=DDMPDWF
 . . . D BLD^DIALOG(525,.DDMPP,.DDMPP)
 . . D FLDBLD(DDMPDWF,.DDMPFLDS,.DDMPSQ,.DDMPFIEN,DDMPTFIX)
 . S DDMPSQ=DDMPSQ+1
 . I DDMPFMT("FIXED")="YES",'$G(DDMPOFIX) D BLD^DIALOG(1822)
 . S DDMPSQ(DDMPSQ)=DDMPF_"~"_DDMPNIEN_"~"_DDMPNFLD_"~"_$G(DDMPOFIX)
 Q
 ;
PUTDRVR(DDMPSQ,DDMPFMT,DDMPFLG,DDMPNODE,DDMPSTAT) ;
 ;Sets up FDA and files data.
 ;DDMPSQ (by reference):   Contains specs for each field.
 ;DDMPFMT (by reference):  Format of imcoming data
 ;DDMPFLG (by reference):  Import control info.
 ;DDMPNODE (by value):     Number of first node containing data.
 N DDMPTPAR,DDMPNDCT,DDMPUPFG,DDMPREF
 I DDMPFLG["E" S DDMPUPFG="E"
 S DDMPNDCT=1
 S DDMPREF=$NA(^TMP($J,"DDMP",DDMPNODE))
 S DDMPTPAR(1)=^TMP($J,"DDMP",DDMPNODE)
 F  S DDMPREF=$Q(@DDMPREF) Q:DDMPREF'[($J_",""DDMP""")  D  Q:$G(DDMPSTAT("ABORT"))
 . I DDMPREF'["OVF" D
 . . D RECPROC
 . . K DDMPTPAR S DDMPNDCT=0
 . S DDMPNDCT=DDMPNDCT+1
 . S DDMPTPAR(DDMPNDCT)=@DDMPREF
 I $G(DDMPSTAT("ABORT")) Q
 D RECPROC
 Q
 ;
RECPROC ; Files a record from DDMPTPAR()
 N DDMPIENS
 K ^TMP($J,"DDMPFDA")
 D TOT(.DDMPSTAT) Q:$G(DDMPSTAT("ABORT"))
 D PARSE(.DDMPSQ,.DDMPTPAR,DDMPNDCT)
 I '$D(^TMP($J,"DDMPFDA")) D RECERR Q
 D UPDATE^DIE($G(DDMPUPFG),"^TMP($J,""DDMPFDA"")","DDMPIENS")
 I $G(DIERR) D
 . D RECERR
 E  I DDMPSTAT("TOT")-DDMPSTAT("NG")>1 S DDMPSTAT("LIEN")=DDMPIENS(1)
 E  S (DDMPSTAT("FIEN"),DDMPSTAT("LIEN"))=DDMPIENS(1)
 Q
 ;
TOT(DDMPSTAT) ;
 S DDMPSTAT("TOT")=DDMPSTAT("TOT")+1
 I '$D(ZTQUEUED) W "."
 E  I DDMPSTAT("TOT")#10=0,$$S^%ZTLOAD D
 . S DDMPSTAT("ABORT")=2
 . S ZTSTOP=1
 Q
 ;
RECERR ;
 N DDMPERLN,DDMPERR
 S DDMPSTAT("NG")=DDMPSTAT("NG")+1
 D LDXTMP^DDMP2("Record #"_DDMPSTAT("TOT")_" Rejected:")
 D MSG^DIALOG("AEB",.DDMPERR,$S($D(IOM):IOM-5,1:75))
 S DDMPERLN=0
 F  S DDMPERLN=$O(DDMPERR(DDMPERLN)) Q:'DDMPERLN  D LDXTMP^DDMP2("   "_DDMPERR(DDMPERLN))
 D CLEAN^DIEFU
 I DDMPSTAT("NG")'<DDMPFLG("MAXERR") S DDMPSTAT("ABORT")=1
 Q
 ;
PARSE(DDMPSQ,DDMPTPAR,DDMPNDCT) ;
 N DDMPQ,DDMPHOLD,DDMPIN,DDMPI,DDMPTVAL,DDMPVAL
 I DDMPTPAR(1)="" D BLD^DIALOG(1860) Q
 S DDMPQ="""",DDMPSQ=0
 F DDMPI=1:1:DDMPNDCT S DDMPIN=DDMPTPAR(DDMPI) F  Q:DDMPIN=""!($G(DIERR))  D
 . I $G(DDMPFMT("QUOTED"))="YES",($E(DDMPIN)=DDMPQ!($E($G(DDMPHOLD))=DDMPQ)) D
 . . I $G(DDMPHOLD)]"" D
 . . . I DDMPHOLD'=DDMPQ,$E(DDMPHOLD,$L(DDMPHOLD))=DDMPQ D
 . . . . S DDMPVAL=DDMPHOLD,DDMPHOLD=""
 . . . . S DDMPIN=$P(DDMPIN,DDMPFMT("FDELIM"),2,99)
 . . . E  D
 . . . . S DDMPVAL=DDMPHOLD_$P(DDMPIN,DDMPQ)_DDMPQ,DDMPHOLD=""
 . . . . S DDMPIN=$P($P(DDMPIN,DDMPQ,2,99),DDMPFMT("FDELIM"),2,99)
 . . E  D
 . . . S DDMPTVAL=$P(DDMPIN,DDMPQ,1,2)_$S($L(DDMPIN,DDMPQ)>2:DDMPQ,1:"")
 . . . S DDMPIN=$P(DDMPIN,DDMPTVAL,2)
 . . . I DDMPIN=DDMPFMT("FDELIM") S DDMPIN="",DDMPVAL=DDMPTVAL Q
 . . . S DDMPIN=$P(DDMPIN,DDMPFMT("FDELIM"),2,99)
 . . . I DDMPIN="",DDMPI'=DDMPNDCT S DDMPHOLD=DDMPTVAL Q
 . . . S DDMPVAL=DDMPTVAL
 . E  I $G(DDMPFMT("FDELIM"))'="" D
 . . S DDMPTVAL=$P(DDMPIN,DDMPFMT("FDELIM"))
 . . I $L(DDMPIN,DDMPFMT("FDELIM"))=2,$P(DDMPIN,DDMPFMT("FDELIM"),2)="" S DDMPIN="",DDMPVAL=$G(DDMPHOLD)_DDMPTVAL,DDMPHOLD="" Q
 . . S DDMPIN=$P(DDMPIN,DDMPFMT("FDELIM"),2,99)
 . . I $G(DDMPHOLD)]"" S DDMPVAL=DDMPHOLD_DDMPTVAL,DDMPHOLD="" Q
 . . I DDMPIN="",DDMPI'=DDMPNDCT S DDMPHOLD=DDMPTVAL Q
 . . S DDMPVAL=DDMPTVAL
 . E  D
 . . N DDMPLEN,DDMPLAST
 . . I '$D(DDMPSQ(DDMPSQ+1)) D BLD^DIALOG(1862) Q
 . . S DDMPLEN=$P(DDMPSQ(DDMPSQ+1),"~",4)
 . . I $G(DDMPHOLD)]"" D
 . . . S DDMPVAL=DDMPHOLD_$E(DDMPIN,1,DDMPLEN-$L(DDMPHOLD))
 . . . S DDMPIN=$E(DDMPIN,DDMPLEN-$L(DDMPHOLD)+1,255)
 . . . S DDMPHOLD=""
 . . E  D
 . . . S DDMPTVAL=$E(DDMPIN,1,DDMPLEN)
 . . . S DDMPIN=$E(DDMPIN,DDMPLEN+1,255)
 . . . I DDMPIN="",DDMPI'=DDMPNDCT S DDMPHOLD=DDMPTVAL Q
 . . . S DDMPVAL=DDMPTVAL
 . . I $D(DDMPVAL) F  S DDMPLAST=$L(DDMPVAL) Q:$E(DDMPVAL,DDMPLAST)'=" "  S DDMPVAL=$E(DDMPVAL,1,DDMPLAST-1)
 . I $D(DDMPVAL) D  K DDMPVAL
 . . S DDMPSQ=DDMPSQ+1
 . . I '$D(DDMPSQ(DDMPSQ)) D BLD^DIALOG(1862) Q
 . . I $G(DDMPFMT("QUOTED"))="YES" S DDMPVAL=$TR(DDMPVAL,DDMPQ)
 . . D FDASET(DDMPVAL,DDMPSQ(DDMPSQ))
 I $G(DDMPFMT("FIXED"))="YES" F DDMPSQ=DDMPSQ+1:1 Q:'$D(DDMPSQ(DDMPSQ))  S DDMPVAL="" D FDASET(DDMPVAL,DDMPSQ(DDMPSQ))
 Q
 ;
FDASET(DDMPVAL,DDMPSPEC) ;
 S ^TMP($J,"DDMPFDA",$P(DDMPSPEC,"~"),$P(DDMPSPEC,"~",2),$P(DDMPSPEC,"~",3))=DDMPVAL
 Q
 ;