[613] | 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
|
---|