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

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

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1DDMPSM ;SFISC/DPC-IMPORT SCREENMAN CALLS ;9/20/96 10:07
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FILESEL ;
5 ; Called form Post-actin on change of Primary File prompt
6 D PUT^DDSVALF("TMP_NM",1,1,"")
7 I DDSOLD'="",$D(DDMPFDSL) S DDMPOLDF=DDSOLD,DDSBR="3^1^3"
8 E D
9 . K DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPCF,DDMPFDNM
10 . S DDMPF=X
11 . S DDMPFLNM=DDSEXT
12 . D UNED^DDSUTL("FLD_JUMP",1,1,$S(X:0,1:1))
13 . D UNED^DDSUTL("TMP_NM",1,1,$S(X:0,1:1))
14 . D REFRESH^DDSUTL
15 Q
16 ;
17TMPLSCR(DDMPSELF,DDSEXT,DUZ) ;
18 ;called from TMP_NM field.
19 ;DDMPSELF = currently selected primary file.
20 ;DDMPEXT = External value of selected template.
21 I $P(^(0),U,4)'=DDMPSELF Q 0
22 I DUZ(0)["@" Q 1
23 N DDMPRDAC,DDMPI,DDMPOK
24 S DDMPRDAC=$P(^(0),U,3),DDMPOK=0
25 F DDMPI=1:1:$L(DDMPRDAC) I DUZ(0)[$E(DDMPRDAC,DDMPI) S DDMPOK=1 Q
26 Q DDMPOK
27 ;
28CHNGFILE ;
29 ;Called for Post-action on pop-up file change verification page.
30 I X D ;code for changing selected file.
31 . K DDMPFDSL,DDMPCPNM,DDMPCPTH,DDMPFCAP,DDMPCF,DDMPFDNM
32 . S (DDMPOSET,DDMPFDCT)=0
33 . S DDMPF=$$GET^DDSVALF("F_SEL",1,1)
34 . S DDMPFLNM=$$GET^DDSVALF("F_SEL",1,1,"E")
35 . I DDMPF="" D UNED^DDSUTL("FLD_JUMP",1,1,1),UNED^DDSUTL("TMP_NM",1,1,1)
36 . S DDSBR="FLD_JUMP^1^1"
37 . ;D REFRESH^DDSUTL
38 E D
39 . D PUT^DDSVALF("F_SEL",1,1,DDMPOLDF,"I")
40 . S DDSBR="F_SEL^1^1"
41 Q
42 ;
43IXF ;
44 ;Called from input transform of Field Selection field.
45 N D0,DA,DIC,DP,Y S DIC="^DD("_DDMPCF_",",DIC(0)="ENZ" D ^DIC
46 I Y'>0 K X
47 E S (X,DDMPX)=+$P(Y,"E"),DDMPFDNM=Y(0,0)
48 Q
49 ;
50FDPROC ;
51 ;Called from post-action on change of Field Selection prompt.
52 N DDMP0P2
53 S DDMP0P2=$P(^DD(DDMPCF,DDMPX,0),U,2)
54 I +DDMP0P2 D
55 . S DDSBR="FLD"
56 . I 'DDMPFDCT D HLP^DDSUTL($C(7)_"You must select a field in the top level file before entering multiple.") Q
57 . N DDMPI,DDMPOK
58 . F DDMPI=1:1:DDMPFDCT I $P(DDMPFDSL(DDMPI),U,$L(DDMPFDSL(DDMPI),U))=DDMPCF S DDMPOK=1 Q
59 . I '$G(DDMPOK) D HLP^DDSUTL($C(7)_"You must select a field in a subfile before entering one of its multiples.") Q
60 . S DDMPFCAP=$$PATHNM(+DDMP0P2,DDMPFLNM)
61 . S DDMPCPTH=$S($L($G(DDMPCPTH)):DDMPCPTH_":",1:"")_DDMPX_U_DDMPCF
62 . S DDMPCF=+DDMP0P2
63 . S DDMPCPNM=$S($L($G(DDMPCPNM)):DDMPCPNM_":",1:"")_DDMPFDNM
64 E D
65 . S DDMPFDCT=DDMPFDCT+1
66 . S DDMPFDSL(DDMPFDCT)=$S($L($G(DDMPCPTH)):DDMPCPTH_":",1:"")_DDMPX_U_DDMPCF
67 . S DDMPFDSL("CAP",DDMPFDCT)=$S($L($G(DDMPCPNM)):DDMPCPNM_":",1:"")_DDMPFDNM
68 . S DDMPOSET=$S(DDMPFDCT>9:DDMPFDCT-9,1:0)
69 . S DDSBR=$S($G(DDMPSMFF("FIXED"))="YES":"LEN",1:"FLD")
70 Q
71 ;
72PATHNM(DDMPSFNO,DDMPFLNM) ;
73 N DDMPPATH S DDMPPATH=""
74 I $D(^DD(DDMPSFNO,0,"UP")) F D Q:'$D(^DD(DDMPSFNO,0,"UP"))
75 . S DDMPPATH=" : "_$P($P(^DD(DDMPSFNO,0),U),"SUB-FIELD")_"Subfile"_DDMPPATH
76 . S DDMPSFNO=^DD(DDMPSFNO,0,"UP")
77 Q $G(DDMPFLNM,$P(^DIC(DDMPSFNO,0),U))_DDMPPATH
78 ;
79UP1 ;
80 ;Called from post-action on Field Selection prompt if null entered.
81 S DDMPFCAP=$P($G(DDMPFCAP)," : ",1,$L($G(DDMPFCAP)," : ")-1)
82 S DDMPCF=$P(DDMPCPTH,U,$L(DDMPCPTH,U))
83 S DDMPCPTH=$P(DDMPCPTH,":",1,$L(DDMPCPTH,":")-1)
84 S DDMPCPNM=$P(DDMPCPNM,":",1,$L(DDMPCPNM,":")-1)
85 Q
86 ;
87DELFLD ;
88 ;Called from post-action on change of the "Do you want to delete" prompt
89 I DDMPFDCT=0 Q
90 N DDMPL S DDMPL=$L($G(DDMPFDSL(DDMPFDCT-1)),":")
91 I DDMPL=1 D
92 . S DDMPCF=DDMPF
93 . S DDMPFCAP=DDMPFLNM
94 . S (DDMPCPNM,DDMPCPTH)=""
95 E D
96 . S DDMPCF=$P(DDMPFDSL(DDMPFDCT-1),U,$L(DDMPFDSL(DDMPFDCT-1),U))
97 . S DDMPFCAP=$$PATHNM(+DDMPCF,DDMPFLNM)
98 . S DDMPCPTH=$P(DDMPFDSL(DDMPFDCT-1),":",1,DDMPL-1)
99 . S DDMPCPNM=$P(DDMPFDSL("CAP",DDMPFDCT-1),":",1,DDMPL-1)
100 K DDMPFDSL(DDMPFDCT),DDMPFDSL("CAP",DDMPFDCT),DDMPFDSL("LN",DDMPFDCT)
101 S DDMPFDCT=DDMPFDCT-1
102 I DDMPOSET S DDMPOSET=DDMPOSET-1
103 Q
104 ;
105 ;
106VAL ;
107 ;Called from form level validation.
108 N DDMPMSG
109 ;1)Validate format of import.
110 I (($G(DDMPSMFF("FIXED"))="YES")&($G(DDMPSMFF("FDELIM"))'=""))!(($G(DDMPSMFF("FIXED"))'="YES")&($G(DDMPSMFF("FDELIM"))="")) D G VALERR
111 . D BLD^DIALOG(1821)
112 . S DDSERROR=2
113 . S DDSBR="FOR_FMT^1^1"
114 . D MSG^DIALOG("AE",.DDMPMSG)
115 ;
116 ;2) If file specified, move fields selected into DR(). Look for DIERRs created during move.
117 I $G(DDMPF)]"" D
118 . I $$GET^DDSVALF("TMP_NM",1,1)]"" D
119 . . S DDMPFDSL=$$GET^DDSVALF("TMP_NM",1,1,"E")
120 . . D TMPL2SQ^DDMP1(DDMPF,.DDMPFDSL)
121 . I '$D(DDMPFDSL(1)) D Q
122 . . S DDSERROR=$G(DDSERROR)+1
123 . . S DDMPMSG(DDSERROR)="You must specify some fields into which to import data."
124 . . S DDSBR="FLD_JUMP^1^1"
125 . K DDMPDR
126 . S DDMPFDSL=1
127 . N DDMPDIER S DDMPDIER=$G(DIERR)
128 . D TODR^DDMP1(DDMPF,.DDMPFDSL,.DDMPDR)
129 . I $G(DIERR)>DDMPDIER D
130 . . S DDSERROR=$G(DDSERROR)+DIERR
131 . . D MSG^DIALOG("AE",.DDMPMSG)
132 . . S DDSBR="2.2^1^2"
133 . . K DDMPDR
134 ;
135VALERR I $G(DDSERROR) D MSG^DDSUTL(.DDMPMSG) Q
136 Q
137 ;
138FF ;
139 ;Called from post-action on change of the Foreign Format field.
140 N DDMPI
141 I X'="" D
142 . S DDMPSMFF=DDSEXT
143 . S DDMPSMFF("IEN")=X
144 . S DDMPSMFF("FDELIM")=$$GET1^DIQ(.44,X_",",1)
145 . S DDMPSMFF("FIXED")=$$GET1^DIQ(.44,X_",",5)
146 . S DDMPSMFF("QUOTED")=$$GET1^DIQ(.44,X_",",8)
147 . F DDMPI="FIX","FLD_DLM","QUOTE" D
148 . . D PUT^DDSVALF(DDMPI,1,1,"")
149 . . D UNED^DDSUTL(DDMPI,1,1,1)
150 E D
151 . K DDMPSMFF
152 . F DDMPI="FIX","FLD_DLM","QUOTE" D UNED^DDSUTL(DDMPI,1,1,0)
153 Q
Note: See TracBrowser for help on using the repository browser.