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

Last change on this file since 700 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.1 KB
RevLine 
[613]1DDMPU ;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.
4EN ;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 ;
36MKTMPL(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 ;
75DUPNAME(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 ;
92CKDLT() ;
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
Note: See TracBrowser for help on using the repository browser.