File:  [Coherent Logic Development] / freem_fileman / USER / DDXP33.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDXP33	;SFISC/DPC - CREATE EXPORT TEMPLATE (CONT);1/8/93  09:18
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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)="QEAS",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: 	D SHOWFLD G:DDXPOUT FLDTEMP
   10: 	Q
   11: SHOWFLD	;
   12: 	W !!,"Do you want to see the fields stored in the "_DDXPFDNM_" template?"
   13: 	S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
   14: 	I $D(DIRUT) S DDXPOUT=1 Q
   15: 	I Y D  Q:DDXPOUT
   16: 	. W ! S D0=DDXPFDTM D ^DIPT K D0
   17: 	. W !,"Do you want to use this template?"
   18: 	. S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR W !
   19: 	. I 'Y!$D(DIRUT) S DDXPOUT=1
   20: 	. Q
   21: 	S DDXPTMDL=0
   22: 	W !!,"Do you want to delete the "_DDXPFDNM_" template"
   23: 	W !,"after the export template is created?"
   24: 	S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !
   25: 	I $D(DIRUT) S DDXPOUT=1 Q
   26: 	S:Y DDXPTMDL=1
   27: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>