DDXP31.m

DDXP31 ;SFISC/DPC-CREATE EXPORT TEMPLATE ;10/14/94  14:56

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

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

XPT ;

 S DDXPOUT=0

 S DIR(0)="F^2:30",DIR("A")="Enter name for EXPORT Template"

 S DIR("?",1)="Enter the name of the Export Template to be produced.",DIR("?",2)="The name must be from 2 to 30 characters.",DIR("?")="The new Export Template cannot overwrite an existing Print Template file entry."

 D ^DIR K DIR

 I $D(DIRUT) S DDXPOUT=1 Q

 S DIC="^DIPT(",DIC(0)="XL",DLAYGO=0 W ! D ^DIC K DIC,DLAYGO

 I '$P(Y,U,3) W !,$C(7),$P(Y,U,2)_" entry in the Print Template file already exists.",!,"Please enter the name of a new template.",!! G XPT

 S DDXPXTNO=+Y

 Q

LENGTH ;

 W !!,"This template will produce fixed length records."

 W !,"Enter the length of each field below."

 W !,"The specified number should be the length in the TARGET file.",!!

 D GETOUT Q:DDXPOUT

 S DDXPTLEN=0

 S DIR(0)="N^1:255:0",DIR("?")="Enter a number from 1 to 255 as the length of this field in the TARGET file"

 F DDXPFLD=1:1:DDXPTOTF D  I DDXPOUT Q  G LENGTH

 . I DDXPNOUT(DDXPFLD) S DDXPFLEN(DDXPFLD)=0 Q

 . S DIR("A")=DDXPFCAP(DDXPFLD),DDXPOUT=0 D ^DIR

 . I $D(DIRUT) S DDXPOUT=1 Q

 . S DDXPFLEN(DDXPFLD)=Y,DDXPTLEN=DDXPTLEN+Y

 . Q

 K DIR,X,Y

 Q

FLDNAME ;

 W !!,"Enter the name of the fields below in the TARGET file."

 W !,"If you press <RET>, no name will be used.",!!

 D GETOUT Q:DDXPOUT

 S DIR(0)="FO^0:30"

 S DIR("?")="Enter up to 30 characters as the name of this field in the TARGET file"

 F DDXPFLD=1:1:DDXPTOTF D  I DDXPOUT=1 Q  G FLDNAME

 . I DDXPNOUT(DDXPFLD) Q

 . S DIR("A")=DDXPFCAP(DDXPFLD),DDXPOUT=0 D ^DIR

 . I $D(DTOUT)!$D(DUOUT) S DDXPOUT=1 Q

 . S DDXPFFNM(DDXPFLD)=Y

 . Q

 K DIR,X,Y

 Q

DTYPE ;

 W !!,"Enter the data types of the fields being exported below.",!!

 D GETOUT Q:DDXPOUT

 S DIR(0)=".42,1"

 F DDXPFLD=1:1:DDXPTOTF D  I DDXPOUT=1 Q  G DTYPE

 . I DDXPNOUT(DDXPFLD) Q

 . S DIR("A")=DDXPFCAP(DDXPFLD),DIR("B")=$P(^DI(.81,DDXPDT(DDXPFLD),0),U,1),DDXPOUT=0 D ^DIR

 . I $D(DIRUT) S DDXPOUT=1 Q

 . S DDXPDT(DDXPFLD)=+Y

 . Q

 K DIR,X,Y

 Q

IOM ;

 S DDXPOUT=0

 W !!,"Enter the maximum length of a physical record that can be exported.",!,"Enter '^' to stop the creation of an EXPORT template.",!

 I $D(DDXPTLEN) D

 . W "The default shown is based on the total lengths of the fields being exported.",!

 . S DIR("B")=DDXPTLEN+1

 . Q

RIOM S DIR(0)=".44,7" D ^DIR K DIR

 I $D(DTOUT)!$D(DUOUT) S DDXPOUT=1 Q

 I Y>255,$P(DDXPFMZO,U,6) W !!,$C(7),"The length cannot be greater than 255 when sending fixed length records.",! G RIOM

 S DDXPIOM=Y

 Q

ASKDELM ;

 S DDXPOUT=0

 W !!,"You can choose a delimiter to be placed between output fields.",!,"Enter <RET> to use no delimiter.",!,"Enter '^' to stop the creation of an EXPORT template.",!

 S DIR(0)=".44,1" D ^DIR K DIR

 I $D(DUOUT)!$D(DTOUT) S DDXPOUT=1 Q

 S:X="@" Y=X S DDXPDELM=Y

 Q

ASKRDLM ;

 S DDXPOUT=0

 W !!,"You can choose a delimiter to be placed between output records.",!,"Enter <RET> to use no delimiter",!,"Enter '^' to stop the creation of an EXPORT template.",!

 S DIR(0)=".44,2" D ^DIR K DIR

 I $D(DUOUT)!$D(DTOUT) S DDXPOUT=1 Q

 S:X="@" Y=X S DDXPRDLM=Y

 Q

GETOUT ;To see if user wants to continue.

 S DDXPOUT=0

 W "Do you want to continue?"

 S DIR(0)="Y",DIR("B")="YES"

 S DIR("?")="If you do not give this information, an EXPORT template will NOT be created."

 D ^DIR K DIR I $D(DIRUT)!'Y S DDXPOUT=1 Q

 W !!

 Q

DDXP31    ;SFISC/DPC-CREATE EXPORT TEMPLATE ;10/14/94  14:56

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

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

XPT       ;

 +1        SET DDXPOUT=0

 +2        SET DIR(0)="F^2:30"

           SET DIR("A")="Enter name for EXPORT Template"

 +3        SET DIR("?",1)="Enter the name of the Export Template to be produced."

           SET DIR("?",2)="The name must be from 2 to 30 characters."

           SET DIR("?")="The new Export Template cannot overwrite an existing Print Template file entry."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               SET DDXPOUT=1

               QUIT 

 +6        SET DIC="^DIPT("

           SET DIC(0)="XL"

           SET DLAYGO=0

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

 +7        IF '$PIECE(Y,U,3)

               WRITE !,$CHAR(7),$PIECE(Y,U,2)_" entry in the Print Template file already exists.",!,"Please enter the name of a new template.",!!

               GOTO XPT

 +8        SET DDXPXTNO=+Y

 +9        QUIT 

LENGTH    ;

 +1        WRITE !!,"This template will produce fixed length records."

 +2        WRITE !,"Enter the length of each field below."

 +3        WRITE !,"The specified number should be the length in the TARGET file.",!!

 +4        DO GETOUT

           IF DDXPOUT

               QUIT 

 +5        SET DDXPTLEN=0

 +6        SET DIR(0)="N^1:255:0"

           SET DIR("?")="Enter a number from 1 to 255 as the length of this field in the TARGET file"

 +7        FOR DDXPFLD=1:1:DDXPTOTF

               Begin DoDot:1

 +8                IF DDXPNOUT(DDXPFLD)

                       SET DDXPFLEN(DDXPFLD)=0

                       QUIT 

 +9                SET DIR("A")=DDXPFCAP(DDXPFLD)

                   SET DDXPOUT=0

                   DO ^DIR

 +10               IF $DATA(DIRUT)

                       SET DDXPOUT=1

                       QUIT 

 +11               SET DDXPFLEN(DDXPFLD)=Y

                   SET DDXPTLEN=DDXPTLEN+Y

 +12               QUIT 

               End DoDot:1

               IF DDXPOUT

                   QUIT 

                   GOTO LENGTH

 +13       KILL DIR,X,Y

 +14       QUIT 

FLDNAME   ;

 +1        WRITE !!,"Enter the name of the fields below in the TARGET file."

 +2        WRITE !,"If you press <RET>, no name will be used.",!!

 +3        DO GETOUT

           IF DDXPOUT

               QUIT 

 +4        SET DIR(0)="FO^0:30"

 +5        SET DIR("?")="Enter up to 30 characters as the name of this field in the TARGET file"

 +6        FOR DDXPFLD=1:1:DDXPTOTF

               Begin DoDot:1

 +7                IF DDXPNOUT(DDXPFLD)

                       QUIT 

 +8                SET DIR("A")=DDXPFCAP(DDXPFLD)

                   SET DDXPOUT=0

                   DO ^DIR

 +9                IF $DATA(DTOUT)!$DATA(DUOUT)

                       SET DDXPOUT=1

                       QUIT 

 +10               SET DDXPFFNM(DDXPFLD)=Y

 +11               QUIT 

               End DoDot:1

               IF DDXPOUT=1

                   QUIT 

                   GOTO FLDNAME

 +12       KILL DIR,X,Y

 +13       QUIT 

DTYPE     ;

 +1        WRITE !!,"Enter the data types of the fields being exported below.",!!

 +2        DO GETOUT

           IF DDXPOUT

               QUIT 

 +3        SET DIR(0)=".42,1"

 +4        FOR DDXPFLD=1:1:DDXPTOTF

               Begin DoDot:1

 +5                IF DDXPNOUT(DDXPFLD)

                       QUIT 

 +6                SET DIR("A")=DDXPFCAP(DDXPFLD)

                   SET DIR("B")=$PIECE(^DI(.81,DDXPDT(DDXPFLD),0),U,1)

                   SET DDXPOUT=0

                   DO ^DIR

 +7                IF $DATA(DIRUT)

                       SET DDXPOUT=1

                       QUIT 

 +8                SET DDXPDT(DDXPFLD)=+Y

 +9                QUIT 

               End DoDot:1

               IF DDXPOUT=1

                   QUIT 

                   GOTO DTYPE

 +10       KILL DIR,X,Y

 +11       QUIT 

IOM       ;

 +1        SET DDXPOUT=0

 +2        WRITE !!,"Enter the maximum length of a physical record that can be exported.",!,"Enter '^' to stop the creation of an EXPORT template.",!

 +3        IF $DATA(DDXPTLEN)

               Begin DoDot:1

 +4                WRITE "The default shown is based on the total lengths of the fields being exported.",!

 +5                SET DIR("B")=DDXPTLEN+1

 +6                QUIT 

               End DoDot:1

RIOM       SET DIR(0)=".44,7"

           DO ^DIR

           KILL DIR

 +1        IF $DATA(DTOUT)!$DATA(DUOUT)

               SET DDXPOUT=1

               QUIT 

 +2        IF Y>255

               IF $PIECE(DDXPFMZO,U,6)

                   WRITE !!,$CHAR(7),"The length cannot be greater than 255 when sending fixed length records.",!

                   GOTO RIOM

 +3        SET DDXPIOM=Y

 +4        QUIT 

ASKDELM   ;

 +1        SET DDXPOUT=0

 +2        WRITE !!,"You can choose a delimiter to be placed between output fields.",!,"Enter <RET> to use no delimiter.",!,"Enter '^' to stop the creation of an EXPORT template.",!

 +3        SET DIR(0)=".44,1"

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DUOUT)!$DATA(DTOUT)

               SET DDXPOUT=1

               QUIT 

 +5        IF X="@"

               SET Y=X

           SET DDXPDELM=Y

 +6        QUIT 

ASKRDLM   ;

 +1        SET DDXPOUT=0

 +2        WRITE !!,"You can choose a delimiter to be placed between output records.",!,"Enter <RET> to use no delimiter",!,"Enter '^' to stop the creation of an EXPORT template.",!

 +3        SET DIR(0)=".44,2"

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DUOUT)!$DATA(DTOUT)

               SET DDXPOUT=1

               QUIT 

 +5        IF X="@"

               SET Y=X

           SET DDXPRDLM=Y

 +6        QUIT 

GETOUT    ;To see if user wants to continue.

 +1        SET DDXPOUT=0

 +2        WRITE "Do you want to continue?"

 +3        SET DIR(0)="Y"

           SET DIR("B")="YES"

 +4        SET DIR("?")="If you do not give this information, an EXPORT template will NOT be created."

 +5        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!'Y

               SET DDXPOUT=1

               QUIT 

 +6        WRITE !!

 +7        QUIT