source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDXP3.m@ 757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1DDXP3 ;SFISC/DPC-CREATE EXPORT TEMPLATE ;10/14/94 14:56
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN1 ;
5 N DDXPNOUT
6 N T,Q S T="~",Q="""" K ^TMP($J,"DIP")
7 N Y,D,DICS D ^DICRW I Y=-1 G QUIT
8 S DDXPFINO=+Y
9FLDT ;
10 D FLDTEMP^DDXP33 G:DDXPOUT QUIT
11FRMT ;
12 S DIC="^DIST(.44,",DIC(0)="QEAMZ" D ^DIC K DIC
13 G:Y=-1 QUIT
14 S DDXPFMNO=+Y,DDXPFMZO=Y(0)
15XPTEMP ;
16 D XPT^DDXP31 G:DDXPOUT QUIT
17 D FLOAD,CAPDT^DDXP32 G:DDXPOUT QUIT
18 I $P(DDXPFMZO,U,6) D LENGTH^DDXP31 G:DDXPOUT QUIT
19 I $P(DDXPFMZO,U,7) D FLDNAME^DDXP31 G:DDXPOUT QUIT
20 I $P(DDXPFMZO,U,11) D DTYPE^DDXP31 G:DDXPOUT QUIT
21 D SETFLD^DDXP32
22 I '$P(DDXPFMZO,U,8) D IOM^DDXP31 G:DDXPOUT QUIT S ^DIPT(DDXPXTNO,"IOM")=$G(DDXPIOM)
23 D SETEMP^DDXP32
24SETDELM ;
25 I $TR($P(DDXPFMZO,U,2),"ask","ASK")="ASK" D ASKDELM^DDXP31 G:DDXPOUT QUIT
26 S:'$D(DDXPDELM) DDXPDELM=$P(DDXPFMZO,U,2)
27 I DDXPDELM]"" S DDXPDELM=$$BLDELIM(DDXPDELM)
28TPROC ;
29 S DDXPFONO=1,DDXPFOUT="",DDXPXPOS=1
30 F DDXPFLD=1:1:DDXPTOTF D
31 . S (DDXPNPC,DDXPRNPC)=^TMP($J,"TIN",DDXPFLD)
32 . I $P(DDXPFMZO,U,10),'DDXPNOUT(DDXPFLD) D QUOT^DDXP32
33 . I $P(DDXPFMZO,U,6) D FIXLEN
34 . I '$P(DDXPFMZO,U,6),((DDXPFLD'=1)!(DDXPNPC'=DDXPRNPC)) D RUNON
35 . I $P(DDXPFMZO,U,10),'DDXPNOUT(DDXPFLD) D QUOT^DDXP32
36 . I DDXPDELM]"",'DDXPNOUT(DDXPFLD) D DELIM
37 . D FPROC
38 . Q
39RECPROC ;
40 I '$P(DDXPFMZO,U,12),DDXPDELM]"" S DDXPFOUT=$P(DDXPFOUT,T,1,($L(DDXPFOUT,T)-2))_T
41 I $TR($P(DDXPFMZO,U,3),"ask","ASK")="ASK" D ASKRDLM^DDXP31 G:DDXPOUT QUIT
42 S:'$D(DDXPRDLM) DDXPRDLM=$P(DDXPFMZO,U,3)
43 I DDXPRDLM]"" S DDXPRDLM=$$BLDELIM(DDXPRDLM) D RECDELIM D FPROC
44FINISH ;
45 I DDXPFOUT]"" S ^DIPT(DDXPXTNO,"F",DDXPFONO)=DDXPFOUT
46 S DIE="^DIST(.44,",DA=DDXPFMNO,DR="40///1" D ^DIE
47 S DIE="^DIPT(",DA=DDXPFDTM,DR="110///1" D ^DIE K DIE,DA,DR
48 W !!,?10,"Export Template created.",!
49 I $G(DDXPTMDL) D
50 . S DIK="^DIPT(",DA=DDXPFDTM D ^DIK K DIK,DA
51 . W ?10,"Selected Fields template "_DDXPFDNM_" deleted.",!
52 . Q
53 G DONE
54QUIT ;
55 W !!,?10,"Export Template NOT created!!"
56 I $G(DDXPTMDL) W !,?10,"Selected Fields template "_DDXPFDNM_" not deleted."
57 I $D(DDXPXTNO) S DIK="^DIPT(",DA=DDXPXTNO D ^DIK K DIK,DA
58DONE ;
59 K X,Y,DDXPDELM,DDXPDT,DDXPFDTM,DDXPFCAP,DDXPFFNM,DDXPFIN,DDXPFINO,DDXPFLD,DDXPIOM,DDXPFLEN,DDXPFMNO,DDXPFMZO,DDXPFONO,DDXPTLEN,DDXPTMDL
60 K DDXPFDNM,DDXPFOUT,DDXPLNMX,DDXPRNPC,DDXPNPC,DDXPOUT,DDXPTIN,DDXPATH,DDXPTOTF,DDXPXPOS,DDXPXTNM,DDXPXTNO,DDXPRDLM,Q,T,DTOUT,DUOUT,DIRUT
61 K ^TMP($J,"DIP")
62 Q
63FLOAD ;
64 S DDXPFLD=0
65 F FIN=0:0 S FIN=$O(^DIPT(DDXPFDTM,"F",FIN)) Q:FIN="" S DDXPFIN=^(FIN) D
66 . F TCNT=1:1 S DDXPTIN=$P(DDXPFIN,T,TCNT) Q:DDXPTIN="" D
67 . . S DDXPFLD=DDXPFLD+1
68 . . S ^TMP($J,"TIN",DDXPFLD)=DDXPTIN
69 . . S DDXPNOUT(DDXPFLD)=$$NOUT(DDXPTIN)
70 . . Q
71 . Q
72 S DDXPTOTF=DDXPFLD
73 K FIN,TCNT Q
74FIXLEN ;
75 S DDXPLNMX=$S(+$P(DDXPFMZO,U,8):$P(DDXPFMZO,U,8),$G(DDXPIOM):DDXPIOM,1:80)
76 I DDXPXPOS+DDXPFLEN(DDXPFLD)>(DDXPLNMX+1) S DDXPXPOS=1
77 S DDXPNPC=DDXPNPC_";L"_DDXPFLEN(DDXPFLD)_";C"_DDXPXPOS
78 S DDXPXPOS=DDXPXPOS+DDXPFLEN(DDXPFLD)
79 Q
80RUNON ;
81 S DDXPNPC=DDXPNPC_";X"
82 Q
83DELIM ;
84 S DDXPNPC=DDXPNPC_T_"W $C("_DDXPDELM_")"
85 I '$P(DDXPFMZO,U,6) D RUNON
86 Q
87RECDELIM ;
88 S DDXPNPC="W $C("_DDXPRDLM_")"
89 I '$P(DDXPFMZO,U,6) D RUNON
90 Q
91BLDELIM(%) ;
92 N CHAR,DELM
93 I +% S DELM=% G BLDOUT
94 S DELM=$A(%)
95 F CHAR=2:1 Q:$E(%,CHAR)="" S DELM=DELM_","_$A($E(%,CHAR))
96BLDOUT Q DELM
97FPROC ;
98 I $L(DDXPFOUT)+$L(DDXPNPC)<220 S DDXPFOUT=DDXPFOUT_DDXPNPC_T Q
99 S ^DIPT(DDXPXTNO,"F",DDXPFONO)=DDXPFOUT
100 S DDXPFOUT=DDXPNPC_T,DDXPFONO=DDXPFONO+1
101 Q
102 ;
103NOUT(DDXPTIN) ;
104 I DDXPTIN["SETDATA"!(DDXPTIN["SETPARAM") Q 1
105 Q 0
Note: See TracBrowser for help on using the repository browser.