- 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
- ;
- DDMP ;SFISC/DPC-IMPORT ASCII DATA ;9/23/96 14:58
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- FILE(DDMPF,DDMPFLDS,DDMPFLG,DDMPFSRC,DDMPFMT) ;
- +1 ;API for import tool.
- +2 ;DDMPF - file# of primary import file.
- +3 ;DDMPFLDS (by ref or value) - 1) name of import template (in [])
- +4 ; 2) ;-delimited fields array. Primary file in top element.
- +5 ; Other nodes subscripted by subfile#.
- +6 ;DDMPFLG (by ref.) - ("FLAGS"): 'E'xternal; 'F'ile contains specs
- +7 ; ("MSGS"): Root to contain error messages.
- +8 ; ("MAXERR"): Maximum # of errors allowed.
- +9 ; ("IOP"): Device for report printing.
- +10 ; ("QTIME"): Queue import time.
- +11 ;DDMPFSRC (by ref.) -("PATH"): Path to source file
- +12 ; ("FILE"): Source file name.
- +13 ;DDMPFMT (by value or ref.) - 1) top node = foreign format.
- +14 ; 2) ("FDELIM"): Field delimiter.
- +15 ; ("FIXED"): YES if fixed format.
- +16 ; ("QUOTED"): YES if delimited fields quoted.
- +17 ;
- +18 IF '$DATA(DIQUIET)
- NEW DIQUIET
- SET DIQUIET=1
- +19 IF '$DATA(DIFM)
- NEW DIFM
- SET DIFM=1
- DO INIZE^DIEFU
- +20 NEW DDMPNCNT
- +21 SET DDMPFLG=$GET(DDMPFLG("FLAGS"),$GET(DDMPFLG))
- IF '$$VERFLG^DIEFU(DDMPFLG,"FE")
- GOTO OUT
- +22 SET DDMPFLG("MAXERR")=$GET(DDMPFLG("MAXERR"),1000)
- +23 SET DDMPFSRC("PATH")=$GET(DDMPFSRC("PATH"))
- +24 IF $GET(DDMPFSRC("FILE"))=""
- DO BLD^DIALOG(202,"host source file","host source file")
- GOTO OUT
- +25 DO GETFMT^DDMP1(.DDMPFMT)
- IF $GET(DIERR)
- GOTO OUT
- +26 DO GETSRC^DDMP1(.DDMPFSRC)
- IF '$DATA(^TMP($JOB,"DDMP"))
- GOTO OUT
- +27 SET DDMPNCNT=$ORDER(^TMP($JOB,"DDMP",""))
- +28 IF DDMPFLG["F"
- Begin DoDot:1
- +29 IF $GET(DDMPF)'=""!($DATA(DDMPFLDS)&($GET(DDMPFLDS)'=""))
- DO BLD^DIALOG(1833)
- QUIT
- +30 DO INFILE^DDMP1("^TMP($J,""DDMP"")",.DDMPFMT,.DDMPF,.DDMPFLDS,.DDMPNCNT)
- End DoDot:1
- IF $GET(DIERR)
- GOTO OUT
- +31 IF '$TEST
- IF $GET(DDMPF)=""!('$DATA(DDMPFLDS))
- DO BLD^DIALOG(202,"file or the fields","file or the fields")
- GOTO OUT
- +32 IF DDMPNCNT=""
- DO BLD^DIALOG(1812,DDMPFSRC("FILE"),DDMPFSRC("FILE"))
- GOTO OUT
- +33 ;import template processing
- IF $EXTRACT($GET(DDMPFLDS))="["
- NEW DDMPERR
- Begin DoDot:1
- +34 SET DDMPERR=$GET(DIERR)
- +35 DO TMPL2DR^DDMP1(DDMPF,.DDMPFLDS)
- End DoDot:1
- IF DDMPERR'=$GET(DIERR)
- GOTO OUT
- +36 SET DDMPFLDS(DDMPF)=$GET(DDMPFLDS(DDMPF),$GET(DDMPFLDS))
- +37 IF '$$RQIDOK^DDMP1(.DDMPFLDS)
- GOTO OUT
- +38 NEW DDMPSQ,DDMPFIEN
- SET (DDMPSQ,DDMPFIEN)=0
- +39 DO FLDBLD(DDMPF,.DDMPFLDS,.DDMPSQ,.DDMPFIEN,1)
- IF $GET(DIERR)
- GOTO OUT
- +40 ;Device and queuing setup.
- NEW DDMPIOP,ZTSK,POP
- +41 DO DEV^DDMP2(.DDMPFLG,.DDMPIOP)
- +42 IF $GET(DDMPIOP("NG"))
- DO BLD^DIALOG(1850)
- GOTO OUT
- +43 IF $GET(DDMPIOP("Q"))
- DO QUE^DDMP2(.DDMPIOP)
- GOTO OUT
- TASK ;Entry point for queued imports. If not queued, processing continues.
- +1 NEW DDMPRPSB,DDMPLN,DDMPSTAT,POP
- +2 DO REP1^DDMP2(.DDMPRPSB,.DDMPLN)
- +3 SET DDMPSTAT("BEG")=$HOROLOG
- SET (DDMPSTAT("TOT"),DDMPSTAT("NG"))=0
- +4 DO PUTDRVR(.DDMPSQ,.DDMPFMT,.DDMPFLG,DDMPNCNT,.DDMPSTAT)
- +5 DO REP2^DDMP2(DDMPRPSB,DDMPLN,.DDMPSTAT)
- OUT IF $DATA(ZTQUEUED)
- Begin DoDot:1
- +1 SET ZTREQ="@"
- +2 DO CLEAN^DIEFU
- End DoDot:1
- +3 IF '$TEST
- IF $GET(DDMPFLG("MSGS"))]""
- DO CALLOUT^DIEFU(DDMPFLG("MSGS"))
- +4 KILL ^TMP($JOB,"DDMP")
- +5 ;K ^XTMP(DDMPRPSB) ;Deletes the report from XTMP
- +6 QUIT
- +7 ;
- FLDBLD(DDMPF,DDMPFLDS,DDMPSQ,DDMPFIEN,DDMPTFIX) ;
- +1 NEW DDMPI,DDMPNFLD,DDMPNIEN,DDMPINFD
- +2 SET DDMPFIEN=DDMPFIEN+1
- +3 SET DDMPNIEN="+"_DDMPFIEN_","_$GET(DDMPFIEN("UP",DDMPF))
- +4 FOR DDMPI=1:1
- SET DDMPINFD=$PIECE(DDMPFLDS(DDMPF),";",DDMPI)
- IF DDMPINFD=""
- QUIT
- Begin DoDot:1
- +5 IF DDMPINFD'["["
- SET DDMPNFLD=DDMPINFD
- +6 IF '$TEST
- NEW DDMPOFIX
- SET DDMPNFLD=+DDMPINFD
- SET DDMPOFIX=$PIECE($PIECE(DDMPINFD,"]"),"[",2)
- +7 IF '$$VFIELD^DIEFU(DDMPF,DDMPNFLD,"D")
- QUIT
- +8 NEW DDMP0P2
- +9 SET DDMP0P2=$PIECE($GET(^DD(DDMPF,DDMPNFLD,0)),U,2)
- +10 IF +DDMP0P2
- Begin DoDot:2
- +11 NEW DDMPDWF
- +12 IF $PIECE($GET(^DD(+DDMP0P2,.01,0)),U,2)["W"
- Begin DoDot:3
- +13 NEW DDMPE
- SET DDMPE(1)="word processing"
- SET DDMPE("FILE")=DDMPF
- SET DDMPE("FIELD")=DDMPNFLD
- +14 DO BLD^DIALOG(520,"word processing",.DDMPE)
- End DoDot:3
- QUIT
- +15 SET DDMPDWF=+DDMP0P2
- +16 SET DDMPFIEN("UP",DDMPDWF)=DDMPNIEN
- +17 IF '$DATA(DDMPFLDS(DDMPDWF))
- Begin DoDot:3
- +18 NEW DDMPP
- SET DDMPP("FILE")=DDMPDWF
- +19 DO BLD^DIALOG(525,.DDMPP,.DDMPP)
- End DoDot:3
- QUIT
- +20 DO FLDBLD(DDMPDWF,.DDMPFLDS,.DDMPSQ,.DDMPFIEN,DDMPTFIX)
- End DoDot:2
- QUIT
- +21 SET DDMPSQ=DDMPSQ+1
- +22 IF DDMPFMT("FIXED")="YES"
- IF '$GET(DDMPOFIX)
- DO BLD^DIALOG(1822)
- +23 SET DDMPSQ(DDMPSQ)=DDMPF_"~"_DDMPNIEN_"~"_DDMPNFLD_"~"_$GET(DDMPOFIX)
- End DoDot:1
- IF $GET(DIERR)
- QUIT
- +24 QUIT
- +25 ;
- PUTDRVR(DDMPSQ,DDMPFMT,DDMPFLG,DDMPNODE,DDMPSTAT) ;
- +1 ;Sets up FDA and files data.
- +2 ;DDMPSQ (by reference): Contains specs for each field.
- +3 ;DDMPFMT (by reference): Format of imcoming data
- +4 ;DDMPFLG (by reference): Import control info.
- +5 ;DDMPNODE (by value): Number of first node containing data.
- +6 NEW DDMPTPAR,DDMPNDCT,DDMPUPFG,DDMPREF
- +7 IF DDMPFLG["E"
- SET DDMPUPFG="E"
- +8 SET DDMPNDCT=1
- +9 SET DDMPREF=$NAME(^TMP($JOB,"DDMP",DDMPNODE))
- +10 SET DDMPTPAR(1)=^TMP($JOB,"DDMP",DDMPNODE)
- +11 FOR
- SET DDMPREF=$QUERY(@DDMPREF)
- IF DDMPREF'[($JOB_",""DDMP""")
- QUIT
- Begin DoDot:1
- +12 IF DDMPREF'["OVF"
- Begin DoDot:2
- +13 DO RECPROC
- +14 KILL DDMPTPAR
- SET DDMPNDCT=0
- End DoDot:2
- +15 SET DDMPNDCT=DDMPNDCT+1
- +16 SET DDMPTPAR(DDMPNDCT)=@DDMPREF
- End DoDot:1
- IF $GET(DDMPSTAT("ABORT"))
- QUIT
- +17 IF $GET(DDMPSTAT("ABORT"))
- QUIT
- +18 DO RECPROC
- +19 QUIT
- +20 ;
- RECPROC ; Files a record from DDMPTPAR()
- +1 NEW DDMPIENS
- +2 KILL ^TMP($JOB,"DDMPFDA")
- +3 DO TOT(.DDMPSTAT)
- IF $GET(DDMPSTAT("ABORT"))
- QUIT
- +4 DO PARSE(.DDMPSQ,.DDMPTPAR,DDMPNDCT)
- +5 IF '$DATA(^TMP($JOB,"DDMPFDA"))
- DO RECERR
- QUIT
- +6 DO UPDATE^DIE($GET(DDMPUPFG),"^TMP($J,""DDMPFDA"")","DDMPIENS")
- +7 IF $GET(DIERR)
- Begin DoDot:1
- +8 DO RECERR
- End DoDot:1
- +9 IF '$TEST
- IF DDMPSTAT("TOT")-DDMPSTAT("NG")>1
- SET DDMPSTAT("LIEN")=DDMPIENS(1)
- +10 IF '$TEST
- SET (DDMPSTAT("FIEN"),DDMPSTAT("LIEN"))=DDMPIENS(1)
- +11 QUIT
- +12 ;
- TOT(DDMPSTAT) ;
- +1 SET DDMPSTAT("TOT")=DDMPSTAT("TOT")+1
- +2 IF '$DATA(ZTQUEUED)
- WRITE "."
- +3 IF '$TEST
- IF DDMPSTAT("TOT")#10=0
- IF $$S^%ZTLOAD
- Begin DoDot:1
- +4 SET DDMPSTAT("ABORT")=2
- +5 SET ZTSTOP=1
- End DoDot:1
- +6 QUIT
- +7 ;
- RECERR ;
- +1 NEW DDMPERLN,DDMPERR
- +2 SET DDMPSTAT("NG")=DDMPSTAT("NG")+1
- +3 DO LDXTMP^DDMP2("Record #"_DDMPSTAT("TOT")_" Rejected:")
- +4 DO MSG^DIALOG("AEB",.DDMPERR,$SELECT($DATA(IOM):IOM-5,1:75))
- +5 SET DDMPERLN=0
- +6 FOR
- SET DDMPERLN=$ORDER(DDMPERR(DDMPERLN))
- IF 'DDMPERLN
- QUIT
- DO LDXTMP^DDMP2(" "_DDMPERR(DDMPERLN))
- +7 DO CLEAN^DIEFU
- +8 IF DDMPSTAT("NG")'<DDMPFLG("MAXERR")
- SET DDMPSTAT("ABORT")=1
- +9 QUIT
- +10 ;
- PARSE(DDMPSQ,DDMPTPAR,DDMPNDCT) ;
- +1 NEW DDMPQ,DDMPHOLD,DDMPIN,DDMPI,DDMPTVAL,DDMPVAL
- +2 IF DDMPTPAR(1)=""
- DO BLD^DIALOG(1860)
- QUIT
- +3 SET DDMPQ=""""
- SET DDMPSQ=0
- +4 FOR DDMPI=1:1:DDMPNDCT
- SET DDMPIN=DDMPTPAR(DDMPI)
- FOR
- IF DDMPIN=""!($GET(DIERR))
- QUIT
- Begin DoDot:1
- +5 IF $GET(DDMPFMT("QUOTED"))="YES"
- IF ($EXTRACT(DDMPIN)=DDMPQ!($EXTRACT($GET(DDMPHOLD))=DDMPQ))
- Begin DoDot:2
- +6 IF $GET(DDMPHOLD)]""
- Begin DoDot:3
- +7 IF DDMPHOLD'=DDMPQ
- IF $EXTRACT(DDMPHOLD,$LENGTH(DDMPHOLD))=DDMPQ
- Begin DoDot:4
- +8 SET DDMPVAL=DDMPHOLD
- SET DDMPHOLD=""
- +9 SET DDMPIN=$PIECE(DDMPIN,DDMPFMT("FDELIM"),2,99)
- End DoDot:4
- +10 IF '$TEST
- Begin DoDot:4
- +11 SET DDMPVAL=DDMPHOLD_$PIECE(DDMPIN,DDMPQ)_DDMPQ
- SET DDMPHOLD=""
- +12 SET DDMPIN=$PIECE($PIECE(DDMPIN,DDMPQ,2,99),DDMPFMT("FDELIM"),2,99)
- End DoDot:4
- End DoDot:3
- +13 IF '$TEST
- Begin DoDot:3
- +14 SET DDMPTVAL=$PIECE(DDMPIN,DDMPQ,1,2)_$SELECT($LENGTH(DDMPIN,DDMPQ)>2:DDMPQ,1:"")
- +15 SET DDMPIN=$PIECE(DDMPIN,DDMPTVAL,2)
- +16 IF DDMPIN=DDMPFMT("FDELIM")
- SET DDMPIN=""
- SET DDMPVAL=DDMPTVAL
- QUIT
- +17 SET DDMPIN=$PIECE(DDMPIN,DDMPFMT("FDELIM"),2,99)
- +18 IF DDMPIN=""
- IF DDMPI'=DDMPNDCT
- SET DDMPHOLD=DDMPTVAL
- QUIT
- +19 SET DDMPVAL=DDMPTVAL
- End DoDot:3
- End DoDot:2
- +20 IF '$TEST
- IF $GET(DDMPFMT("FDELIM"))'=""
- Begin DoDot:2
- +21 SET DDMPTVAL=$PIECE(DDMPIN,DDMPFMT("FDELIM"))
- +22 IF $LENGTH(DDMPIN,DDMPFMT("FDELIM"))=2
- IF $PIECE(DDMPIN,DDMPFMT("FDELIM"),2)=""
- SET DDMPIN=""
- SET DDMPVAL=$GET(DDMPHOLD)_DDMPTVAL
- SET DDMPHOLD=""
- QUIT
- +23 SET DDMPIN=$PIECE(DDMPIN,DDMPFMT("FDELIM"),2,99)
- +24 IF $GET(DDMPHOLD)]""
- SET DDMPVAL=DDMPHOLD_DDMPTVAL
- SET DDMPHOLD=""
- QUIT
- +25 IF DDMPIN=""
- IF DDMPI'=DDMPNDCT
- SET DDMPHOLD=DDMPTVAL
- QUIT
- +26 SET DDMPVAL=DDMPTVAL
- End DoDot:2
- +27 IF '$TEST
- Begin DoDot:2
- +28 NEW DDMPLEN,DDMPLAST
- +29 IF '$DATA(DDMPSQ(DDMPSQ+1))
- DO BLD^DIALOG(1862)
- QUIT
- +30 SET DDMPLEN=$PIECE(DDMPSQ(DDMPSQ+1),"~",4)
- +31 IF $GET(DDMPHOLD)]""
- Begin DoDot:3
- +32 SET DDMPVAL=DDMPHOLD_$EXTRACT(DDMPIN,1,DDMPLEN-$LENGTH(DDMPHOLD))
- +33 SET DDMPIN=$EXTRACT(DDMPIN,DDMPLEN-$LENGTH(DDMPHOLD)+1,255)
- +34 SET DDMPHOLD=""
- End DoDot:3
- +35 IF '$TEST
- Begin DoDot:3
- +36 SET DDMPTVAL=$EXTRACT(DDMPIN,1,DDMPLEN)
- +37 SET DDMPIN=$EXTRACT(DDMPIN,DDMPLEN+1,255)
- +38 IF DDMPIN=""
- IF DDMPI'=DDMPNDCT
- SET DDMPHOLD=DDMPTVAL
- QUIT
- +39 SET DDMPVAL=DDMPTVAL
- End DoDot:3
- +40 IF $DATA(DDMPVAL)
- FOR
- SET DDMPLAST=$LENGTH(DDMPVAL)
- IF $EXTRACT(DDMPVAL,DDMPLAST)'=" "
- QUIT
- SET DDMPVAL=$EXTRACT(DDMPVAL,1,DDMPLAST-1)
- End DoDot:2
- +41 IF $DATA(DDMPVAL)
- Begin DoDot:2
- +42 SET DDMPSQ=DDMPSQ+1
- +43 IF '$DATA(DDMPSQ(DDMPSQ))
- DO BLD^DIALOG(1862)
- QUIT
- +44 IF $GET(DDMPFMT("QUOTED"))="YES"
- SET DDMPVAL=$TRANSLATE(DDMPVAL,DDMPQ)
- +45 DO FDASET(DDMPVAL,DDMPSQ(DDMPSQ))
- End DoDot:2
- KILL DDMPVAL
- End DoDot:1
- +46 IF $GET(DDMPFMT("FIXED"))="YES"
- FOR DDMPSQ=DDMPSQ+1:1
- IF '$DATA(DDMPSQ(DDMPSQ))
- QUIT
- SET DDMPVAL=""
- DO FDASET(DDMPVAL,DDMPSQ(DDMPSQ))
- +47 QUIT
- +48 ;
- FDASET(DDMPVAL,DDMPSPEC) ;
- +1 SET ^TMP($JOB,"DDMPFDA",$PIECE(DDMPSPEC,"~"),$PIECE(DDMPSPEC,"~",2),$PIECE(DDMPSPEC,"~",3))=DDMPVAL
- +2 QUIT
- +3 ;
