1 | DDMPU ;SFISC/DPC-IMPORT USER INTERFACE, TEMPLATE CREATE ;9/12/96 17:07
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | EN ;Entry point for Import Data option.
|
---|
5 | D CLEAN^DIEFU
|
---|
6 | N DIQUIET,DIFM S (DIQUIET,DIFM)=1
|
---|
7 | N DA
|
---|
8 | N DDMPHOST,DDMPSELF,DDMPFLAG,DDMPDR,DDSSAVE,DDMPSMFF,DDMPHOST,DDMPIORE,DDMPFDSL,DDMPTMPL
|
---|
9 | D Q:'$G(DDSSAVE)
|
---|
10 | . N DDSPARM,DDSFILE,DR
|
---|
11 | . N DDMPF,DDMPCF,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPFDCT,DDMPFDNM,DDMPFLNM,DDMPOSET,DDMPX,DDMPFRP4,DDMPOLDF
|
---|
12 | . S DDSFILE=.46,DR="[DDMP SPECIFY IMPORT]",DDSPARM="S" D ^DDS
|
---|
13 | W @IOF
|
---|
14 | I '$D(DDMPSELF) S DDMPFLAG="F"
|
---|
15 | I $G(DDMPIORE)="E" S DDMPFLAG=$G(DDMPFLAG)_"E"
|
---|
16 | I '($G(DDMPTMPL)]""),$D(DDMPSELF) D
|
---|
17 | . N DIR,DIRUT,Y
|
---|
18 | . S DIR(0)="Y"
|
---|
19 | . S DIR("A")="Do you want to store the selected fields in an Import Template"
|
---|
20 | . D ^DIR
|
---|
21 | . I Y D MKTMPL(DDMPSELF,.DDMPFDSL,.DDMPDR)
|
---|
22 | N DIR,DIRUT,Y S DIR(0)="Y"
|
---|
23 | S DIR("A")="Do you want to proceed with the import"
|
---|
24 | S DIR("?",1)="If you answer 'YES', the import will occur now."
|
---|
25 | S DIR("?")="If you answer 'NO', you will need to respecify the import criteria."
|
---|
26 | W ! D ^DIR
|
---|
27 | I 'Y!$G(DIRUT) W !!,"Okay, you can do the import later." Q
|
---|
28 | D FILE^DDMP($G(DDMPSELF),.DDMPDR,$G(DDMPFLAG),.DDMPHOST,.DDMPSMFF)
|
---|
29 | W !!
|
---|
30 | I $G(DIERR) D
|
---|
31 | . W "Following error messages were generated when import failed."
|
---|
32 | . D MSG^DIALOG("","","",3)
|
---|
33 | E I '$G(ZTSK) W "Done."
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | MKTMPL(DDMPF,DDMPFLDS,DDMPDR) ; Create Import Template.
|
---|
37 | N DDMPTPNM,DDMPTPNO,DDMPRCNO,DDMPOUT,DDMPSQ,DIR,DIRUT,Y
|
---|
38 | F D Q:$G(DDMPOUT)!($G(DDMPTPNM)]"")
|
---|
39 | . S DIR(0)="FA^3:30^K:(X?1P.E) X"
|
---|
40 | . S DIR("?")="Enter name for your import template. It should be 3-30 characters and it should not start with a punctuation character"
|
---|
41 | . S DIR("A")="Name of Import Template: "
|
---|
42 | . W ! D ^DIR
|
---|
43 | . I Y']""!$G(DIRUT) S DDMPOUT=1 Q
|
---|
44 | . S DDMPTPNM=Y
|
---|
45 | . S DDMPTPNO=$O(^DIST(.46,"F"_DDMPF,DDMPTPNM,""))
|
---|
46 | . I DDMPTPNO D DUPNAME(DDMPF,.DDMPTPNM,DDMPTPNO) Q:DDMPTPNM=""
|
---|
47 | . S DIR("A")=" Are you adding '"_DDMPTPNM_"' as a new Import Template"
|
---|
48 | . S DIR(0)="Y"
|
---|
49 | . D ^DIR
|
---|
50 | . I 'Y S DDMPTPNM="" Q
|
---|
51 | . K ^TMP($J,"DDMPFDA")
|
---|
52 | . S ^TMP($J,"DDMPFDA",.46,"+1,",.01)=DDMPTPNM
|
---|
53 | . S ^TMP($J,"DDMPFDA",.46,"+1,",4)=DDMPF
|
---|
54 | . S ^TMP($J,"DDMPFDA",.46,"+1,",5)=DUZ
|
---|
55 | . S ^TMP($J,"DDMPFDA",.46,"+1,",2)=DT
|
---|
56 | . S:DUZ(0)'="@" (^TMP($J,"DDMPFDA",.46,"+1,",3),^TMP($J,"DDMPFDA",.46,"+1,",6))=DUZ(0)
|
---|
57 | . F DDMPSQ=1:1 Q:'$D(DDMPFLDS(DDMPSQ)) D
|
---|
58 | . . N DDMPIENS,DDMPLVLS
|
---|
59 | . . S DDMPIENS="+"_(DDMPSQ+1)_",+1,"
|
---|
60 | . . S DDMPLVLS=$L(DDMPFLDS(DDMPSQ),":")
|
---|
61 | . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,.01)=DDMPSQ
|
---|
62 | . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,1)=$P($P(DDMPFLDS(DDMPSQ),":",DDMPLVLS),U,2)
|
---|
63 | . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,2)=+$P(DDMPFLDS(DDMPSQ),":",DDMPLVLS)
|
---|
64 | . . S:$D(DDMPFLDS("LN",DDMPSQ)) ^TMP($J,"DDMPFDA",.463,DDMPIENS,3)=DDMPFLDS("LN",DDMPSQ)
|
---|
65 | . . S:DDMPLVLS>1 ^TMP($J,"DDMPFDA",.463,DDMPIENS,10)=$P(DDMPFLDS(DDMPSQ),":",1,DDMPLVLS-1)
|
---|
66 | . . S ^TMP($J,"DDMPFDA",.463,DDMPIENS,20)=DDMPFLDS("CAP",DDMPSQ)
|
---|
67 | . N DDMPERR S DDMPERR=$G(DIERR)
|
---|
68 | . D UPDATE^DIE("","^TMP($J,""DDMPFDA"")","DDMPRCNO")
|
---|
69 | . I DDMPERR'=$G(DIERR) W !,"An error occurred during the filing of the import template." S DDMPOUT=1 Q
|
---|
70 | . D RECALL^DILFD(.46,DDMPRCNO(1)_",",DUZ)
|
---|
71 | . I DUZ(0)="@" S $P(^DIST(.46,DDMPRCNO(1),0),U,3)="@",$P(^(0),U,6)="@"
|
---|
72 | I $G(DDMPOUT) W !,"No import template will be created."
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | DUPNAME(DDMPF,DDMPTPNM,DDMPTPNO) ;selected template exists.
|
---|
76 | ;If Import template name remains in DDMPTPNM after subroutine,
|
---|
77 | ;user has chosen to delete existing template.
|
---|
78 | W !!,"Import Template "_DDMPTPNM_" already exists."
|
---|
79 | N DDMPDLOK S DDMPDLOK=0
|
---|
80 | I DUZ(0)="@" D
|
---|
81 | . S DDMPDLOK=$$CKDLT
|
---|
82 | E D
|
---|
83 | . N DDMPWRAC,I
|
---|
84 | . S DDMPWRAC=$$GET1^DIQ(.46,DDMPTPNO_",",6)
|
---|
85 | . F I=1:1:$L(DDMPWRAC) I DUZ(0)[$E(DDMPWRAC,I) S DDMPDLOK=$$CKDLT Q
|
---|
86 | I DDMPDLOK D
|
---|
87 | . N DIK,DA S DIK="^DIST(.46,",DA=DDMPTPNO D ^DIK
|
---|
88 | . W !,"Existing Import Template "_DDMPTPNM_" has been deleted."
|
---|
89 | E S DDMPTPNM="" W !!,"Choose another template name."
|
---|
90 | Q
|
---|
91 | ;
|
---|
92 | CKDLT() ;
|
---|
93 | ;user has write access to the template. Do they want to delete it?
|
---|
94 | N DIR,DIRUT
|
---|
95 | S DIR(0)="Y"
|
---|
96 | S DIR("A")="Do you want to replace the existing template with a new one"
|
---|
97 | S DIR("?",1)="If you answer 'YES', the existing template will be deleted."
|
---|
98 | S DIR("?")="Answer YES or NO."
|
---|
99 | D ^DIR
|
---|
100 | I 'Y!$G(DIRUT) Q 0
|
---|
101 | Q 1
|
---|