DDMPU ;SFISC/DPC-IMPORT USER INTERFACE, TEMPLATE CREATE ;9/12/96 17:07
;;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.
;
EN ;Entry point for Import Data option.
D CLEAN^DIEFU
N DIQUIET,DIFM S (DIQUIET,DIFM)=1
N DA
N DDMPHOST,DDMPSELF,DDMPFLAG,DDMPDR,DDSSAVE,DDMPSMFF,DDMPHOST,DDMPIORE,DDMPFDSL,DDMPTMPL
D Q:'$G(DDSSAVE)
. N DDSPARM,DDSFILE,DR
. N DDMPF,DDMPCF,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPFDCT,DDMPFDNM,DDMPFLNM,DDMPOSET,DDMPX,DDMPFRP4,DDMPOLDF
. S DDSFILE=.46,DR="[DDMP SPECIFY IMPORT]",DDSPARM="S" D ^DDS
W @IOF
I '$D(DDMPSELF) S DDMPFLAG="F"
I $G(DDMPIORE)="E" S DDMPFLAG=$G(DDMPFLAG)_"E"
I '($G(DDMPTMPL)]""),$D(DDMPSELF) D
. N DIR,DIRUT,Y
. S DIR(0)="Y"
. S DIR("A")="Do you want to store the selected fields in an Import Template"
. D ^DIR
. I Y D MKTMPL(DDMPSELF,.DDMPFDSL,.DDMPDR)
N DIR,DIRUT,Y S DIR(0)="Y"
S DIR("A")="Do you want to proceed with the import"
S DIR("?",1)="If you answer 'YES', the import will occur now."
S DIR("?")="If you answer 'NO', you will need to respecify the import criteria."
W ! D ^DIR
I 'Y!$G(DIRUT) W !!,"Okay, you can do the import later." Q
D FILE^DDMP($G(DDMPSELF),.DDMPDR,$G(DDMPFLAG),.DDMPHOST,.DDMPSMFF)
W !!
I $G(DIERR) D
. W "Following error messages were generated when import failed."
. D MSG^DIALOG("","","",3)
E I '$G(ZTSK) W "Done."
Q
;
MKTMPL(DDMPF,DDMPFLDS,DDMPDR) ; Create Import Template.
N DDMPTPNM,DDMPTPNO,DDMPRCNO,DDMPOUT,DDMPSQ,DIR,DIRUT,Y
F D Q:$G(DDMPOUT)!($G(DDMPTPNM)]"")
. S DIR(0)="FA^3:30^K:(X?1P.E) X"
. S DIR("?")="Enter name for your import template. It should be 3-30 characters and it should not start with a punctuation character"
. S DIR("A")="Name of Import Template: "
. W ! D ^DIR
. I Y']""!$G(DIRUT) S DDMPOUT=1 Q
. S DDMPTPNM=Y
. S DDMPTPNO=$O(^DIST(.46,"F"_DDMPF,DDMPTPNM,""))
. I DDMPTPNO D DUPNAME(DDMPF,.DDMPTPNM,DDMPTPNO) Q:DDMPTPNM=""
. S DIR("A")=" Are you adding '"_DDMPTPNM_"' as a new Import Template"
. S DIR(0)="Y"
. D ^DIR
. I 'Y S DDMPTPNM="" Q
. K ^TMP($J,"DDMPFDA")
. S ^TMP($J,"DDMPFDA",.46,"+1,",.01)=DDMPTPNM
. S ^TMP($J,"DDMPFDA",.46,"+1,",4)=DDMPF
. S ^TMP($J,"DDMPFDA",.46,"+1,",5)=DUZ
. S ^TMP($J,"DDMPFDA",.46,"+1,",2)=DT
. S:DUZ(0)'="@" (^TMP($J,"DDMPFDA",.46,"+1,",3),^TMP($J,"DDMPFDA",.46,"+1,",6))=DUZ(0)
. F DDMPSQ=1:1 Q:'$D(DDMPFLDS(DDMPSQ)) D
. . N DDMPIENS,DDMPLVLS
. . S DDMPIENS="+"_(DDMPSQ+1)_",+1,"
. . S DDMPLVLS=$L(DDMPFLDS(DDMPSQ),":")
. . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,.01)=DDMPSQ
. . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,1)=$P($P(DDMPFLDS(DDMPSQ),":",DDMPLVLS),U,2)
. . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,2)=+$P(DDMPFLDS(DDMPSQ),":",DDMPLVLS)
. . S:$D(DDMPFLDS("LN",DDMPSQ)) ^TMP($J,"DDMPFDA",.463,DDMPIENS,3)=DDMPFLDS("LN",DDMPSQ)
. . S:DDMPLVLS>1 ^TMP($J,"DDMPFDA",.463,DDMPIENS,10)=$P(DDMPFLDS(DDMPSQ),":",1,DDMPLVLS-1)
. . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,20)=DDMPFLDS("CAP",DDMPSQ)
. N DDMPERR S DDMPERR=$G(DIERR)
. D UPDATE^DIE("","^TMP($J,""DDMPFDA"")","DDMPRCNO")
. I DDMPERR'=$G(DIERR) W !,"An error occurred during the filing of the import template." S DDMPOUT=1 Q
. D RECALL^DILFD(.46,DDMPRCNO(1)_",",DUZ)
. I DUZ(0)="@" S $P(^DIST(.46,DDMPRCNO(1),0),U,3)="@",$P(^(0),U,6)="@"
I $G(DDMPOUT) W !,"No import template will be created."
Q
;
DUPNAME(DDMPF,DDMPTPNM,DDMPTPNO) ;selected template exists.
;If Import template name remains in DDMPTPNM after subroutine,
;user has chosen to delete existing template.
W !!,"Import Template "_DDMPTPNM_" already exists."
N DDMPDLOK S DDMPDLOK=0
I DUZ(0)="@" D
. S DDMPDLOK=$$CKDLT
E D
. N DDMPWRAC,I
. S DDMPWRAC=$$GET1^DIQ(.46,DDMPTPNO_",",6)
. F I=1:1:$L(DDMPWRAC) I DUZ(0)[$E(DDMPWRAC,I) S DDMPDLOK=$$CKDLT Q
I DDMPDLOK D
. N DIK,DA S DIK="^DIST(.46,",DA=DDMPTPNO D ^DIK
. W !,"Existing Import Template "_DDMPTPNM_" has been deleted."
E S DDMPTPNM="" W !!,"Choose another template name."
Q
;
CKDLT() ;
;user has write access to the template. Do they want to delete it?
N DIR,DIRUT
S DIR(0)="Y"
S DIR("A")="Do you want to replace the existing template with a new one"
S DIR("?",1)="If you answer 'YES', the existing template will be deleted."
S DIR("?")="Answer YES or NO."
D ^DIR
I 'Y!$G(DIRUT) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDMPU 4544 printed Apr 09, 2024@21:48 Page 2
DDMPU ;SFISC/DPC-IMPORT USER INTERFACE, TEMPLATE CREATE ;9/12/96 17:07
+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 ;
EN ;Entry point for Import Data option.
+1 DO CLEAN^DIEFU
+2 NEW DIQUIET,DIFM
SET (DIQUIET,DIFM)=1
+3 NEW DA
+4 NEW DDMPHOST,DDMPSELF,DDMPFLAG,DDMPDR,DDSSAVE,DDMPSMFF,DDMPHOST,DDMPIORE,DDMPFDSL,DDMPTMPL
+5 Begin DoDot:1
+6 NEW DDSPARM,DDSFILE,DR
+7 NEW DDMPF,DDMPCF,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPFDCT,DDMPFDNM,DDMPFLNM,DDMPOSET,DDMPX,DDMPFRP4,DDMPOLDF
+8 SET DDSFILE=.46
SET DR="[DDMP SPECIFY IMPORT]"
SET DDSPARM="S"
DO ^DDS
End DoDot:1
if '$GET(DDSSAVE)
QUIT
+9 WRITE @IOF
+10 IF '$DATA(DDMPSELF)
SET DDMPFLAG="F"
+11 IF $GET(DDMPIORE)="E"
SET DDMPFLAG=$GET(DDMPFLAG)_"E"
+12 IF '($GET(DDMPTMPL)]"")
IF $DATA(DDMPSELF)
Begin DoDot:1
+13 NEW DIR,DIRUT,Y
+14 SET DIR(0)="Y"
+15 SET DIR("A")="Do you want to store the selected fields in an Import Template"
+16 DO ^DIR
+17 IF Y
DO MKTMPL(DDMPSELF,.DDMPFDSL,.DDMPDR)
End DoDot:1
+18 NEW DIR,DIRUT,Y
SET DIR(0)="Y"
+19 SET DIR("A")="Do you want to proceed with the import"
+20 SET DIR("?",1)="If you answer 'YES', the import will occur now."
+21 SET DIR("?")="If you answer 'NO', you will need to respecify the import criteria."
+22 WRITE !
DO ^DIR
+23 IF 'Y!$GET(DIRUT)
WRITE !!,"Okay, you can do the import later."
QUIT
+24 DO FILE^DDMP($GET(DDMPSELF),.DDMPDR,$GET(DDMPFLAG),.DDMPHOST,.DDMPSMFF)
+25 WRITE !!
+26 IF $GET(DIERR)
Begin DoDot:1
+27 WRITE "Following error messages were generated when import failed."
+28 DO MSG^DIALOG("","","",3)
End DoDot:1
+29 IF '$TEST
IF '$GET(ZTSK)
WRITE "Done."
+30 QUIT
+31 ;
MKTMPL(DDMPF,DDMPFLDS,DDMPDR) ; Create Import Template.
+1 NEW DDMPTPNM,DDMPTPNO,DDMPRCNO,DDMPOUT,DDMPSQ,DIR,DIRUT,Y
+2 FOR
Begin DoDot:1
+3 SET DIR(0)="FA^3:30^K:(X?1P.E) X"
+4 SET DIR("?")="Enter name for your import template. It should be 3-30 characters and it should not start with a punctuation character"
+5 SET DIR("A")="Name of Import Template: "
+6 WRITE !
DO ^DIR
+7 IF Y']""!$GET(DIRUT)
SET DDMPOUT=1
QUIT
+8 SET DDMPTPNM=Y
+9 SET DDMPTPNO=$ORDER(^DIST(.46,"F"_DDMPF,DDMPTPNM,""))
+10 IF DDMPTPNO
DO DUPNAME(DDMPF,.DDMPTPNM,DDMPTPNO)
if DDMPTPNM=""
QUIT
+11 SET DIR("A")=" Are you adding '"_DDMPTPNM_"' as a new Import Template"
+12 SET DIR(0)="Y"
+13 DO ^DIR
+14 IF 'Y
SET DDMPTPNM=""
QUIT
+15 KILL ^TMP($JOB,"DDMPFDA")
+16 SET ^TMP($JOB,"DDMPFDA",.46,"+1,",.01)=DDMPTPNM
+17 SET ^TMP($JOB,"DDMPFDA",.46,"+1,",4)=DDMPF
+18 SET ^TMP($JOB,"DDMPFDA",.46,"+1,",5)=DUZ
+19 SET ^TMP($JOB,"DDMPFDA",.46,"+1,",2)=DT
+20 if DUZ(0)'="@"
SET (^TMP($JOB,"DDMPFDA",.46,"+1,",3),^TMP($JOB,"DDMPFDA",.46,"+1,",6))=DUZ(0)
+21 FOR DDMPSQ=1:1
if '$DATA(DDMPFLDS(DDMPSQ))
QUIT
Begin DoDot:2
+22 NEW DDMPIENS,DDMPLVLS
+23 SET DDMPIENS="+"_(DDMPSQ+1)_",+1,"
+24 SET DDMPLVLS=$LENGTH(DDMPFLDS(DDMPSQ),":")
+25 SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,.01)=DDMPSQ
+26 SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,1)=$PIECE($PIECE(DDMPFLDS(DDMPSQ),":",DDMPLVLS),U,2)
+27 SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,2)=+$PIECE(DDMPFLDS(DDMPSQ),":",DDMPLVLS)
+28 if $DATA(DDMPFLDS("LN",DDMPSQ))
SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,3)=DDMPFLDS("LN",DDMPSQ)
+29 if DDMPLVLS>1
SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,10)=$PIECE(DDMPFLDS(DDMPSQ),":",1,DDMPLVLS-1)
+30 SET ^TMP($JOB,"DDMPFDA",.463,DDMPIENS,20)=DDMPFLDS("CAP",DDMPSQ)
End DoDot:2
+31 NEW DDMPERR
SET DDMPERR=$GET(DIERR)
+32 DO UPDATE^DIE("","^TMP($J,""DDMPFDA"")","DDMPRCNO")
+33 IF DDMPERR'=$GET(DIERR)
WRITE !,"An error occurred during the filing of the import template."
SET DDMPOUT=1
QUIT
+34 DO RECALL^DILFD(.46,DDMPRCNO(1)_",",DUZ)
+35 IF DUZ(0)="@"
SET $PIECE(^DIST(.46,DDMPRCNO(1),0),U,3)="@"
SET $PIECE(^(0),U,6)="@"
End DoDot:1
if $GET(DDMPOUT)!($GET(DDMPTPNM)]"")
QUIT
+36 IF $GET(DDMPOUT)
WRITE !,"No import template will be created."
+37 QUIT
+38 ;
DUPNAME(DDMPF,DDMPTPNM,DDMPTPNO) ;selected template exists.
+1 ;If Import template name remains in DDMPTPNM after subroutine,
+2 ;user has chosen to delete existing template.
+3 WRITE !!,"Import Template "_DDMPTPNM_" already exists."
+4 NEW DDMPDLOK
SET DDMPDLOK=0
+5 IF DUZ(0)="@"
Begin DoDot:1
+6 SET DDMPDLOK=$$CKDLT
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 NEW DDMPWRAC,I
+9 SET DDMPWRAC=$$GET1^DIQ(.46,DDMPTPNO_",",6)
+10 FOR I=1:1:$LENGTH(DDMPWRAC)
IF DUZ(0)[$EXTRACT(DDMPWRAC,I)
SET DDMPDLOK=$$CKDLT
QUIT
End DoDot:1
+11 IF DDMPDLOK
Begin DoDot:1
+12 NEW DIK,DA
SET DIK="^DIST(.46,"
SET DA=DDMPTPNO
DO ^DIK
+13 WRITE !,"Existing Import Template "_DDMPTPNM_" has been deleted."
End DoDot:1
+14 IF '$TEST
SET DDMPTPNM=""
WRITE !!,"Choose another template name."
+15 QUIT
+16 ;
CKDLT() ;
+1 ;user has write access to the template. Do they want to delete it?
+2 NEW DIR,DIRUT
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Do you want to replace the existing template with a new one"
+5 SET DIR("?",1)="If you answer 'YES', the existing template will be deleted."
+6 SET DIR("?")="Answer YES or NO."
+7 DO ^DIR
+8 IF 'Y!$GET(DIRUT)
QUIT 0
+9 QUIT 1
