1 | DDXP33 ;SFISC/DPC - CREATE EXPORT TEMPLATE (CONT) ;12:45 PM 7 Jun 1999
|
---|
2 | ;;22.0;VA FileMan;**9**;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | FLDTEMP ;
|
---|
5 | S DDXPOUT=0
|
---|
6 | S DIC="^DIPT(",DIC(0)="QEASZ",DIC("S")="I $P(^(0),U,8)=7",DIC("A")="Enter SELECTED EXPORT FIELDS Template: ",D="F"_DDXPFINO W ! D IX^DIC K DIC,D
|
---|
7 | I Y=-1 S DDXPOUT=1 Q
|
---|
8 | S DDXPFDTM=+Y,DDXPFDNM=$P(Y,U,2)
|
---|
9 | N DDXPY
|
---|
10 | S DDXPY=Y(0)
|
---|
11 | D SHOWFLD G:DDXPOUT FLDTEMP
|
---|
12 | Q
|
---|
13 | SHOWFLD ;
|
---|
14 | W !!,"Do you want to see the fields stored in the "_DDXPFDNM_" template?"
|
---|
15 | S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
|
---|
16 | I $D(DIRUT) S DDXPOUT=1 Q
|
---|
17 | I Y D Q:DDXPOUT
|
---|
18 | . W ! S D0=DDXPFDTM D ^DIPT K D0
|
---|
19 | . W !,"Do you want to use this template?"
|
---|
20 | . S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR W !
|
---|
21 | . I 'Y!$D(DIRUT) S DDXPOUT=1
|
---|
22 | . Q
|
---|
23 | S DDXPTMDL=0
|
---|
24 | I DUZ(0)[$E($P(DDXPY,U,6),1)!(DUZ(0)="@") D I $D(DIRUT) K DDXPY S DDXPOUT=1 Q
|
---|
25 | . W !!,"Do you want to delete the "_DDXPFDNM_" template"
|
---|
26 | . W !,"after the export template is created?"
|
---|
27 | . S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !
|
---|
28 | . S:Y DDXPTMDL=1
|
---|
29 | . K DDXPY
|
---|
30 | Q
|
---|