DDMP1 ;SFISC/DPC-ASCII IMPORT UTIILTIES ;9/19/96 14:58
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
GETFMT(DDMPFMT) ;
; Sets up format info.
;DDMPFMT passed by reference.
N DDMPFRMT
I '($D(DDMPFMT)\10) D Q:'($D(DDMPFMT)\10)
. D FIND^DIC(.44,"","1;5;8","X",DDMPFMT,"","","","","DDMPFRMT")
. I 'DDMPFRMT("DILIST",0) D BLD^DIALOG(1820,DDMPFMT,DDMPFMT) Q
. S DDMPFMT("IEN")=DDMPFRMT("DILIST",2,1)
. S DDMPFMT("FDELIM")=DDMPFRMT("DILIST","ID",1,1)
. S DDMPFMT("FIXED")=DDMPFRMT("DILIST","ID",1,5)
. S DDMPFMT("QUOTED")=DDMPFRMT("DILIST","ID",1,8)
S DDMPFMT("FDELIM")=$G(DDMPFMT("FDELIM"))
I DDMPFMT("FDELIM") D
. N DDMPI,DDMPPC,DDMPASCI S DDMPASCI=""
. F DDMPI=1:1 S DDMPPC=$P(DDMPFMT("FDELIM"),",",DDMPI) Q:'DDMPPC S DDMPASCI=DDMPASCI_$C(DDMPPC)
. S DDMPFMT("FDELIM")=DDMPASCI
S DDMPFMT("QUOTED")=$G(DDMPFMT("QUOTED"),"NO")
S DDMPFMT("FIXED")=$G(DDMPFMT("FIXED"),"NO")
I ((DDMPFMT("FIXED")="YES")&(DDMPFMT("FDELIM")'=""))!((DDMPFMT("FIXED")'="YES")&(DDMPFMT("FDELIM")="")) D BLD^DIALOG(1821)
Q
;
GETSRC(DDMPFSRC) ;
;Moves data from source file into global.
N DDMPIMWK
K ^TMP($J,"DDMP")
S DDMPIMWK=$$FTG^%ZISH(DDMPFSRC("PATH"),DDMPFSRC("FILE"),$NA(^TMP($J,"DDMP",0)),3)
I 'DDMPIMWK D BLD^DIALOG(1810,DDMPFSRC("FILE"),DDMPFSRC("FILE")) Q
I '$D(^TMP($J,"DDMP")) D BLD^DIALOG(1812,DDMPFSRC("FILE"),DDMPFSRC("FILE"))
Q
;
RQIDOK(DDMPFLDS) ;
;Verifies that required identifiers present in fields being imported.
N DDMPF,DDMPRIDS,DDMPRID,DDMPERCT S DDMPF=0,DDMPERCT=$G(DIERR)
F S DDMPF=$O(DDMPFLDS(DDMPF)) Q:DDMPF="" D
. D REQIDS^DICU(DDMPF,"DDMPRIDS")
. S DDMPRID=0
. F S DDMPRID=$O(DDMPRIDS("REQUIRED IDENTIFIERS",DDMPRID)) Q:DDMPRID="" D
. . I ";"_DDMPFLDS(DDMPF)_";"'[(";"_DDMPRID_";"),";"_DDMPFLDS(DDMPF)'[(";"_DDMPRID_"[") D
. . . N DDMPP S DDMPP("FILE")=DDMPF
. . . D BLD^DIALOG(312,.DDMPP,.DDMPP)
Q DDMPERCT=$G(DIERR)
;
INFILE(DDMPINAR,DDMPFMT,DDMPFBCK,DDMPDR,DDMPNCNT) ;
N DDMPDELM,DDMPFLDS,DDMPF,DDMPFSTR,DDMPI,DDMPJ,DDMPVAL,DDMPDONE
S DDMPNCNT=""
I DDMPFMT("FIXED")="YES" S DDMPDELM=","
E S DDMPDELM=DDMPFMT("FDELIM")
F S DDMPNCNT=$O(@DDMPINAR@(DDMPNCNT)) Q:DDMPNCNT=""!$G(DDMPDONE) S DDMPVAL=^(DDMPNCNT) D Q:$G(DIERR)
. I DDMPVAL="" Q
. I '$D(DDMPF) D Q
. . S DDMPF=$P(DDMPVAL,"FILE=",2)
. . I DDMPF="" D BLD^DIALOG(1831) Q
. . S DDMPF=$$FILENUM(DDMPF)
. F DDMPI=1:1 S DDMPFSTR=$P(DDMPVAL,DDMPDELM,DDMPI) Q:DDMPFSTR="" D
. . N DDMPFDF,DDMPDPTH,DDMPFLD
. . S DDMPDPTH=$L(DDMPFSTR,":")
. . S DDMPFDF=DDMPF
. . F DDMPJ=1:1:DDMPDPTH S DDMPFLD=$P(DDMPFSTR,":",DDMPJ) D Q:$G(DIERR)
. . . N DDMP0P2
. . . D FLDVAL Q:$G(DIERR)
. . . S $P(DDMPFSTR,":",DDMPJ)=DDMPFLD_U_DDMPFDF
. . . S DDMPFDF=+DDMP0P2
. . S DDMPFLDS(DDMPI)=DDMPFSTR
. S DDMPDONE=1
I $O(@DDMPINAR@(DDMPNCNT))="" S DDMPNCNT=""
I $G(DIERR)!(DDMPNCNT="") Q
S DDMPFLDS=1
D TODR(DDMPF,.DDMPFLDS,.DDMPDR)
S DDMPFBCK=DDMPF
Q
;
FILENUM(DDMPF) ;
I DDMPF,$$VFILE^DILFD(DDMPF) Q DDMPF
I $D(^DIC("B",DDMPF))=10 Q $O(^(DDMPF,""))
D BLD^DIALOG(409,DDMPF,DDMPF)
Q 0
FLDVAL ;
N DDMP0
I 'DDMPFLD S DDMPFLD=$$FLDNUM^DILFD(DDMPFDF,DDMPFLD) Q:$G(DIERR)
S DDMP0=$G(^DD(DDMPFDF,DDMPFLD,0))
I DDMP0="" D Q
. N DDMPP S DDMPP("FILE")=DDMPFDF,DDMPP(1)=DDMPFLD
. D BLD^DIALOG(501,.DDMPP,.DDMPP)
S DDMP0P2=$P(DDMP0,U,2)
I 'DDMP0P2 D
. I DDMPJ<DDMPDPTH D BLD^DIALOG(1841)
E D
. I DDMPJ=DDMPDPTH D BLD^DIALOG(1842)
. I $P($G(^DD(+DDMP0P2,.01,0)),U,2)["W" D
. . N DDMPP
. . S DDMPP("FILE")=DDMPFDF,DDMPP("FIELD")=DDMPFLD,DDMPP(1)="word processing"
. . D BLD^DIALOG(520,.DDMPP,.DDMPP)
I DDMPI>1,$P($P(DDMPFLDS(DDMPI-1),":",DDMPJ-1),U,2)'=$P($P(DDMPFSTR,":",DDMPJ-1),U,2) D
. D BLD^DIALOG(1844)
Q
;
TMPL2DR(DDMPF,DDMPFLDS) ;
N DDMPDR
N DDMPERR S DDMPERR=$G(DIERR)
D TMPL2SQ(DDMPF,.DDMPFLDS)
I DDMPERR'=$G(DIERR) Q
S DDMPFLDS=1
D TODR(DDMPF,.DDMPFLDS,.DDMPDR)
K DDMPFLDS
M DDMPFLDS=DDMPDR
Q
;
TMPL2SQ(DDMPF,DDMPFLSQ) ;
N DDMPTPNM,DDMPTPNO,DDMPSQ,DDMPPATH
S DDMPTPNM=$S($E(DDMPFLSQ)="[":$P($P(DDMPFLSQ,"[",2),"]"),1:DDMPFLSQ)
S DDMPTPNO=$O(^DIST(.46,"F"_DDMPF,DDMPTPNM,""))
I 'DDMPTPNO D Q ;Template does not exist.
. N DDMPARAM
. S DDMPARAM(1)=DDMPTPNM,DDMPARAM("FILE")=DDMPF
. D BLD^DIALOG(1870,.DDMPARAM,.DDMPARAM)
D LIST^DIC(.463,","_DDMPTPNO_",","1;2;3;10","I")
I '$D(^TMP("DILIST",$J,0)) Q
F DDMPSQ=1:1:+^TMP("DILIST",$J,0) D
. S DDMPPATH=^TMP("DILIST",$J,"ID",DDMPSQ,10)
. S DDMPFLSQ(DDMPSQ)=$S(DDMPPATH]"":DDMPPATH_":",1:"")_^(2)_U_^(1) ;naked set on prior line.
. I ^(3) S DDMPFLSQ("LN",DDMPSQ)=^(3) ;naked set 2 lines above.
K ^TMP("DILIST",$J)
Q
;
TODR(DDMPF,DDMPFLDS,DDMPDR,DDMPDRTP) ;
N DDMPPPTH,DDMPCPTH,DDMPDPTH,DDMPFDWN,DDMPDONE,DDMPODTH
F D Q:$G(DDMPDONE)!$G(DIERR)
. I '$D(DDMPFLDS(DDMPFLDS)) D TMP2DR Q
. I '$D(DDMPDPTH) S DDMPODTH=$L(DDMPFLDS(DDMPFLDS),":")
. S DDMPDPTH=$L(DDMPFLDS(DDMPFLDS),":")
. I '$D(DDMPCPTH) S DDMPPPTH=$P(DDMPFLDS(DDMPFLDS),":",1,DDMPDPTH-1)
. S DDMPCPTH=$P(DDMPFLDS(DDMPFLDS),":",1,DDMPDPTH-1)
. I DDMPCPTH=DDMPPPTH D
. . I $G(DDMPDRTP(DDMPF))[(";"_+$P(DDMPFLDS(DDMPFLDS),":",DDMPDPTH)_";") D Q
. . . I +$P(DDMPFLDS(DDMPFLDS),":",DDMPDPTH)=$P(DDMPDRTP(DDMPF),";",2),DDMPDPTH>1 D
. . . . D TMP2DR
. . . E D BLD^DIALOG(1845)
. . S DDMPDRTP(DDMPF)=$G(DDMPDRTP(DDMPF),";")_+$P(DDMPFLDS(DDMPFLDS),":",DDMPDPTH)_$S('$D(DDMPFLDS("LN")):"",1:"["_DDMPFLDS("LN",DDMPFLDS)_"]")_";"
. . S DDMPFLDS=DDMPFLDS+1
. . S DDMPPPTH=DDMPCPTH
. . S DDMPODTH=DDMPDPTH
. E I DDMPDPTH'>DDMPODTH D
. . D TMP2DR
. E D
. . S DDMPDRTP(DDMPF)=DDMPDRTP(DDMPF)_+$P(DDMPFLDS(DDMPFLDS),":",DDMPDPTH-1)_";"
. . S DDMPFDWN=$P($P(DDMPFLDS(DDMPFLDS),":",DDMPDPTH),U,2)
. . D TODR(DDMPFDWN,.DDMPFLDS,.DDMPDR,.DDMPDRTP)
Q
;
TMP2DR ;
S DDMPDONE=1
I '$D(DDMPDR(DDMPF)) S DDMPDR(DDMPF)=$E(DDMPDRTP(DDMPF),2,$L(DDMPDRTP(DDMPF))-1)
E I DDMPDR(DDMPF)'=$E(DDMPDRTP(DDMPF),2,$L(DDMPDRTP(DDMPF))-1) D
. D BLD^DIALOG(1846,DDMPF,DDMPF)
K DDMPDRTP(DDMPF)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDMP1 6270 printed Apr 09, 2024@21:53:25 Page 2
DDMP1 ;SFISC/DPC-ASCII IMPORT UTIILTIES ;9/19/96 14:58
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
GETFMT(DDMPFMT) ;
+1 ; Sets up format info.
+2 ;DDMPFMT passed by reference.
+3 NEW DDMPFRMT
+4 IF '($DATA(DDMPFMT)\10)
Begin DoDot:1
+5 DO FIND^DIC(.44,"","1;5;8","X",DDMPFMT,"","","","","DDMPFRMT")
+6 IF 'DDMPFRMT("DILIST",0)
DO BLD^DIALOG(1820,DDMPFMT,DDMPFMT)
QUIT
+7 SET DDMPFMT("IEN")=DDMPFRMT("DILIST",2,1)
+8 SET DDMPFMT("FDELIM")=DDMPFRMT("DILIST","ID",1,1)
+9 SET DDMPFMT("FIXED")=DDMPFRMT("DILIST","ID",1,5)
+10 SET DDMPFMT("QUOTED")=DDMPFRMT("DILIST","ID",1,8)
End DoDot:1
if '($DATA(DDMPFMT)\10)
QUIT
+11 SET DDMPFMT("FDELIM")=$GET(DDMPFMT("FDELIM"))
+12 IF DDMPFMT("FDELIM")
Begin DoDot:1
+13 NEW DDMPI,DDMPPC,DDMPASCI
SET DDMPASCI=""
+14 FOR DDMPI=1:1
SET DDMPPC=$PIECE(DDMPFMT("FDELIM"),",",DDMPI)
if 'DDMPPC
QUIT
SET DDMPASCI=DDMPASCI_$CHAR(DDMPPC)
+15 SET DDMPFMT("FDELIM")=DDMPASCI
End DoDot:1
+16 SET DDMPFMT("QUOTED")=$GET(DDMPFMT("QUOTED"),"NO")
+17 SET DDMPFMT("FIXED")=$GET(DDMPFMT("FIXED"),"NO")
+18 IF ((DDMPFMT("FIXED")="YES")&(DDMPFMT("FDELIM")'=""))!((DDMPFMT("FIXED")'="YES")&(DDMPFMT("FDELIM")=""))
DO BLD^DIALOG(1821)
+19 QUIT
+20 ;
GETSRC(DDMPFSRC) ;
+1 ;Moves data from source file into global.
+2 NEW DDMPIMWK
+3 KILL ^TMP($JOB,"DDMP")
+4 SET DDMPIMWK=$$FTG^%ZISH(DDMPFSRC("PATH"),DDMPFSRC("FILE"),$NAME(^TMP($JOB,"DDMP",0)),3)
+5 IF 'DDMPIMWK
DO BLD^DIALOG(1810,DDMPFSRC("FILE"),DDMPFSRC("FILE"))
QUIT
+6 IF '$DATA(^TMP($JOB,"DDMP"))
DO BLD^DIALOG(1812,DDMPFSRC("FILE"),DDMPFSRC("FILE"))
+7 QUIT
+8 ;
RQIDOK(DDMPFLDS) ;
+1 ;Verifies that required identifiers present in fields being imported.
+2 NEW DDMPF,DDMPRIDS,DDMPRID,DDMPERCT
SET DDMPF=0
SET DDMPERCT=$GET(DIERR)
+3 FOR
SET DDMPF=$ORDER(DDMPFLDS(DDMPF))
if DDMPF=""
QUIT
Begin DoDot:1
+4 DO REQIDS^DICU(DDMPF,"DDMPRIDS")
+5 SET DDMPRID=0
+6 FOR
SET DDMPRID=$ORDER(DDMPRIDS("REQUIRED IDENTIFIERS",DDMPRID))
if DDMPRID=""
QUIT
Begin DoDot:2
+7 IF ";"_DDMPFLDS(DDMPF)_";"'[(";"_DDMPRID_";")
IF ";"_DDMPFLDS(DDMPF)'[(";"_DDMPRID_"[")
Begin DoDot:3
+8 NEW DDMPP
SET DDMPP("FILE")=DDMPF
+9 DO BLD^DIALOG(312,.DDMPP,.DDMPP)
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT DDMPERCT=$GET(DIERR)
+11 ;
INFILE(DDMPINAR,DDMPFMT,DDMPFBCK,DDMPDR,DDMPNCNT) ;
+1 NEW DDMPDELM,DDMPFLDS,DDMPF,DDMPFSTR,DDMPI,DDMPJ,DDMPVAL,DDMPDONE
+2 SET DDMPNCNT=""
+3 IF DDMPFMT("FIXED")="YES"
SET DDMPDELM=","
+4 IF '$TEST
SET DDMPDELM=DDMPFMT("FDELIM")
+5 FOR
SET DDMPNCNT=$ORDER(@DDMPINAR@(DDMPNCNT))
if DDMPNCNT=""!$GET(DDMPDONE)
QUIT
SET DDMPVAL=^(DDMPNCNT)
Begin DoDot:1
+6 IF DDMPVAL=""
QUIT
+7 IF '$DATA(DDMPF)
Begin DoDot:2
+8 SET DDMPF=$PIECE(DDMPVAL,"FILE=",2)
+9 IF DDMPF=""
DO BLD^DIALOG(1831)
QUIT
+10 SET DDMPF=$$FILENUM(DDMPF)
End DoDot:2
QUIT
+11 FOR DDMPI=1:1
SET DDMPFSTR=$PIECE(DDMPVAL,DDMPDELM,DDMPI)
if DDMPFSTR=""
QUIT
Begin DoDot:2
+12 NEW DDMPFDF,DDMPDPTH,DDMPFLD
+13 SET DDMPDPTH=$LENGTH(DDMPFSTR,":")
+14 SET DDMPFDF=DDMPF
+15 FOR DDMPJ=1:1:DDMPDPTH
SET DDMPFLD=$PIECE(DDMPFSTR,":",DDMPJ)
Begin DoDot:3
+16 NEW DDMP0P2
+17 DO FLDVAL
if $GET(DIERR)
QUIT
+18 SET $PIECE(DDMPFSTR,":",DDMPJ)=DDMPFLD_U_DDMPFDF
+19 SET DDMPFDF=+DDMP0P2
End DoDot:3
if $GET(DIERR)
QUIT
+20 SET DDMPFLDS(DDMPI)=DDMPFSTR
End DoDot:2
+21 SET DDMPDONE=1
End DoDot:1
if $GET(DIERR)
QUIT
+22 IF $ORDER(@DDMPINAR@(DDMPNCNT))=""
SET DDMPNCNT=""
+23 IF $GET(DIERR)!(DDMPNCNT="")
QUIT
+24 SET DDMPFLDS=1
+25 DO TODR(DDMPF,.DDMPFLDS,.DDMPDR)
+26 SET DDMPFBCK=DDMPF
+27 QUIT
+28 ;
FILENUM(DDMPF) ;
+1 IF DDMPF
IF $$VFILE^DILFD(DDMPF)
QUIT DDMPF
+2 IF $DATA(^DIC("B",DDMPF))=10
QUIT $ORDER(^(DDMPF,""))
+3 DO BLD^DIALOG(409,DDMPF,DDMPF)
+4 QUIT 0
FLDVAL ;
+1 NEW DDMP0
+2 IF 'DDMPFLD
SET DDMPFLD=$$FLDNUM^DILFD(DDMPFDF,DDMPFLD)
if $GET(DIERR)
QUIT
+3 SET DDMP0=$GET(^DD(DDMPFDF,DDMPFLD,0))
+4 IF DDMP0=""
Begin DoDot:1
+5 NEW DDMPP
SET DDMPP("FILE")=DDMPFDF
SET DDMPP(1)=DDMPFLD
+6 DO BLD^DIALOG(501,.DDMPP,.DDMPP)
End DoDot:1
QUIT
+7 SET DDMP0P2=$PIECE(DDMP0,U,2)
+8 IF 'DDMP0P2
Begin DoDot:1
+9 IF DDMPJ<DDMPDPTH
DO BLD^DIALOG(1841)
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 IF DDMPJ=DDMPDPTH
DO BLD^DIALOG(1842)
+12 IF $PIECE($GET(^DD(+DDMP0P2,.01,0)),U,2)["W"
Begin DoDot:2
+13 NEW DDMPP
+14 SET DDMPP("FILE")=DDMPFDF
SET DDMPP("FIELD")=DDMPFLD
SET DDMPP(1)="word processing"
+15 DO BLD^DIALOG(520,.DDMPP,.DDMPP)
End DoDot:2
End DoDot:1
+16 IF DDMPI>1
IF $PIECE($PIECE(DDMPFLDS(DDMPI-1),":",DDMPJ-1),U,2)'=$PIECE($PIECE(DDMPFSTR,":",DDMPJ-1),U,2)
Begin DoDot:1
+17 DO BLD^DIALOG(1844)
End DoDot:1
+18 QUIT
+19 ;
TMPL2DR(DDMPF,DDMPFLDS) ;
+1 NEW DDMPDR
+2 NEW DDMPERR
SET DDMPERR=$GET(DIERR)
+3 DO TMPL2SQ(DDMPF,.DDMPFLDS)
+4 IF DDMPERR'=$GET(DIERR)
QUIT
+5 SET DDMPFLDS=1
+6 DO TODR(DDMPF,.DDMPFLDS,.DDMPDR)
+7 KILL DDMPFLDS
+8 MERGE DDMPFLDS=DDMPDR
+9 QUIT
+10 ;
TMPL2SQ(DDMPF,DDMPFLSQ) ;
+1 NEW DDMPTPNM,DDMPTPNO,DDMPSQ,DDMPPATH
+2 SET DDMPTPNM=$SELECT($EXTRACT(DDMPFLSQ)="[":$PIECE($PIECE(DDMPFLSQ,"[",2),"]"),1:DDMPFLSQ)
+3 SET DDMPTPNO=$ORDER(^DIST(.46,"F"_DDMPF,DDMPTPNM,""))
+4 ;Template does not exist.
IF 'DDMPTPNO
Begin DoDot:1
+5 NEW DDMPARAM
+6 SET DDMPARAM(1)=DDMPTPNM
SET DDMPARAM("FILE")=DDMPF
+7 DO BLD^DIALOG(1870,.DDMPARAM,.DDMPARAM)
End DoDot:1
QUIT
+8 DO LIST^DIC(.463,","_DDMPTPNO_",","1;2;3;10","I")
+9 IF '$DATA(^TMP("DILIST",$JOB,0))
QUIT
+10 FOR DDMPSQ=1:1:+^TMP("DILIST",$JOB,0)
Begin DoDot:1
+11 SET DDMPPATH=^TMP("DILIST",$JOB,"ID",DDMPSQ,10)
+12 ;naked set on prior line.
SET DDMPFLSQ(DDMPSQ)=$SELECT(DDMPPATH]"":DDMPPATH_":",1:"")_^(2)_U_^(1)
+13 ;naked set 2 lines above.
IF ^(3)
SET DDMPFLSQ("LN",DDMPSQ)=^(3)
End DoDot:1
+14 KILL ^TMP("DILIST",$JOB)
+15 QUIT
+16 ;
TODR(DDMPF,DDMPFLDS,DDMPDR,DDMPDRTP) ;
+1 NEW DDMPPPTH,DDMPCPTH,DDMPDPTH,DDMPFDWN,DDMPDONE,DDMPODTH
+2 FOR
Begin DoDot:1
+3 IF '$DATA(DDMPFLDS(DDMPFLDS))
DO TMP2DR
QUIT
+4 IF '$DATA(DDMPDPTH)
SET DDMPODTH=$LENGTH(DDMPFLDS(DDMPFLDS),":")
+5 SET DDMPDPTH=$LENGTH(DDMPFLDS(DDMPFLDS),":")
+6 IF '$DATA(DDMPCPTH)
SET DDMPPPTH=$PIECE(DDMPFLDS(DDMPFLDS),":",1,DDMPDPTH-1)
+7 SET DDMPCPTH=$PIECE(DDMPFLDS(DDMPFLDS),":",1,DDMPDPTH-1)
+8 IF DDMPCPTH=DDMPPPTH
Begin DoDot:2
+9 IF $GET(DDMPDRTP(DDMPF))[(";"_+$PIECE(DDMPFLDS(DDMPFLDS),":",DDMPDPTH)_";")
Begin DoDot:3
+10 IF +$PIECE(DDMPFLDS(DDMPFLDS),":",DDMPDPTH)=$PIECE(DDMPDRTP(DDMPF),";",2)
IF DDMPDPTH>1
Begin DoDot:4
+11 DO TMP2DR
End DoDot:4
+12 IF '$TEST
DO BLD^DIALOG(1845)
End DoDot:3
QUIT
+13 SET DDMPDRTP(DDMPF)=$GET(DDMPDRTP(DDMPF),";")_+$PIECE(DDMPFLDS(DDMPFLDS),":",DDMPDPTH)_$SELECT('$DATA(DDMPFLDS("LN")):"",1:"["_DDMPFLDS("LN",DDMPFLDS)_"]")_";"
+14 SET DDMPFLDS=DDMPFLDS+1
+15 SET DDMPPPTH=DDMPCPTH
+16 SET DDMPODTH=DDMPDPTH
End DoDot:2
+17 IF '$TEST
IF DDMPDPTH'>DDMPODTH
Begin DoDot:2
+18 DO TMP2DR
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 SET DDMPDRTP(DDMPF)=DDMPDRTP(DDMPF)_+$PIECE(DDMPFLDS(DDMPFLDS),":",DDMPDPTH-1)_";"
+21 SET DDMPFDWN=$PIECE($PIECE(DDMPFLDS(DDMPFLDS),":",DDMPDPTH),U,2)
+22 DO TODR(DDMPFDWN,.DDMPFLDS,.DDMPDR,.DDMPDRTP)
End DoDot:2
End DoDot:1
if $GET(DDMPDONE)!$GET(DIERR)
QUIT
+23 QUIT
+24 ;
TMP2DR ;
+1 SET DDMPDONE=1
+2 IF '$DATA(DDMPDR(DDMPF))
SET DDMPDR(DDMPF)=$EXTRACT(DDMPDRTP(DDMPF),2,$LENGTH(DDMPDRTP(DDMPF))-1)
+3 IF '$TEST
IF DDMPDR(DDMPF)'=$EXTRACT(DDMPDRTP(DDMPF),2,$LENGTH(DDMPDRTP(DDMPF))-1)
Begin DoDot:1
+4 DO BLD^DIALOG(1846,DDMPF,DDMPF)
End DoDot:1
+5 KILL DDMPDRTP(DDMPF)
+6 QUIT
+7 ;
