DDXP33.m

DDXP33 ;SFISC/DPC - CREATE EXPORT TEMPLATE (CONT) ;12:45 PM  7 Jun 1999 [ 04/02/2003   8:25 AM ]

 ;;22.0;VA FileMan;**1001**;APR 1, 2003

 ;;22.0;VA FileMan;**9**;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

FLDTEMP ;

 S DDXPOUT=0

 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

 I Y=-1 S DDXPOUT=1 Q

 S DDXPFDTM=+Y,DDXPFDNM=$P(Y,U,2)

 N DDXPY

 S DDXPY=Y(0)

 D SHOWFLD G:DDXPOUT FLDTEMP

 Q

SHOWFLD ;

 W !!,"Do you want to see the fields stored in the "_DDXPFDNM_" template?"

 S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR

 I $D(DIRUT) S DDXPOUT=1 Q

 I Y D  Q:DDXPOUT

 . W ! S D0=DDXPFDTM D ^DIPT K D0

 . W !,"Do you want to use this template?"

 . S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR W !

 . I 'Y!$D(DIRUT) S DDXPOUT=1

 . Q

 S DDXPTMDL=0

 I DUZ(0)[$E($P(DDXPY,U,6),1)!(DUZ(0)="@") D  I $D(DIRUT) K DDXPY S DDXPOUT=1 Q

 . W !!,"Do you want to delete the "_DDXPFDNM_" template"

 . W !,"after the export template is created?"

 . S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !

 . S:Y DDXPTMDL=1

 . K DDXPY

 Q

DDXP33    ;SFISC/DPC - CREATE EXPORT TEMPLATE (CONT) ;12:45 PM  7 Jun 1999 [ 04/02/2003   8:25 AM ]

 +1       ;;22.0;VA FileMan;**1001**;APR 1, 2003

 +2       ;;22.0;VA FileMan;**9**;Mar 30, 1999

 +3       ;Per VHA Directive 10-93-142, this routine should not be modified.

FLDTEMP   ;

 +1        SET DDXPOUT=0

 +2        SET DIC="^DIPT("

           SET DIC(0)="QEASZ"

           SET DIC("S")="I $P(^(0),U,8)=7"

           SET DIC("A")="Enter SELECTED EXPORT FIELDS Template: "

           SET D="F"_DDXPFINO

           WRITE !

           DO IX^DIC

           KILL DIC,D

 +3        IF Y=-1

               SET DDXPOUT=1

               QUIT 

 +4        SET DDXPFDTM=+Y

           SET DDXPFDNM=$PIECE(Y,U,2)

 +5        NEW DDXPY

 +6        SET DDXPY=Y(0)

 +7        DO SHOWFLD

           IF DDXPOUT

               GOTO FLDTEMP

 +8        QUIT 

SHOWFLD   ;

 +1        WRITE !!,"Do you want to see the fields stored in the "_DDXPFDNM_" template?"

 +2        SET DIR(0)="Y"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET DDXPOUT=1

               QUIT 

 +4        IF Y

               Begin DoDot:1

 +5                WRITE !

                   SET D0=DDXPFDTM

                   DO ^DIPT

                   KILL D0

 +6                WRITE !,"Do you want to use this template?"

 +7                SET DIR(0)="Y"

                   SET DIR("B")="YES"

                   DO ^DIR

                   KILL DIR

                   WRITE !

 +8                IF 'Y!$DATA(DIRUT)

                       SET DDXPOUT=1

 +9                QUIT 

               End DoDot:1

               IF DDXPOUT

                   QUIT 

 +10       SET DDXPTMDL=0

 +11       IF DUZ(0)[$EXTRACT($PIECE(DDXPY,U,6),1)!(DUZ(0)="@")

               Begin DoDot:1

 +12               WRITE !!,"Do you want to delete the "_DDXPFDNM_" template"

 +13               WRITE !,"after the export template is created?"

 +14               SET DIR(0)="Y"

                   SET DIR("B")="NO"

                   DO ^DIR

                   KILL DIR

                   WRITE !

 +15               IF Y

                       SET DDXPTMDL=1

 +16               KILL DDXPY

               End DoDot:1

               IF $DATA(DIRUT)

                   KILL DDXPY

                   SET DDXPOUT=1

                   QUIT 

 +17       QUIT