DDXP31.m

DDXP31 ;SFISC/DPC-CREATE EXPORT TEMPLATE ;30SEP2004

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

XPT ;

 N DIC,DIR,DLAYGO

 W ! 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

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

 S DIC("S")="I $P(^(0),U,8)=3,$P(^(0),U,4)=DDXPFINO,$P(^(0),U,5)=DUZ!'$P(^(0),U,5)" ;**GFT Let them pick one of their own existing EXPORT TEMPLATES for this FILE

 S DIC="^DIPT(",DIC(0)="AOVELZ",DLAYGO=0 W ! D ^DIC I Y<0 S DDXPOUT=1 Q

 I '$P(Y,U,3) S $P(^(0),U,4)="",X=0 F  S X=$O(^(X)) Q:X=""  K ^(X) ;Throw away FILE so it can be stuffed back. throw away rest of Template

 ;'$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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DDXP31   4057     printed  Mar 13, 2025@21:48:55                                                                                                                                                                                                      Page 2

DDXP31    ;SFISC/DPC-CREATE EXPORT TEMPLATE ;30SEP2004

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

XPT       ;

 +1        NEW DIC,DIR,DLAYGO

 +2        WRITE !

           SET DDXPOUT=0

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

 +4       ;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."

 +5       ;D ^DIR

 +6       ;I $D(DIRUT) S DDXPOUT=1 Q

 +7       ;**GFT Let them pick one of their own existing EXPORT TEMPLATES for this FILE

           SET DIC("S")="I $P(^(0),U,8)=3,$P(^(0),U,4)=DDXPFINO,$P(^(0),U,5)=DUZ!'$P(^(0),U,5)"

 +8        SET DIC="^DIPT("

           SET DIC(0)="AOVELZ"

           SET DLAYGO=0

           WRITE !

           DO ^DIC

           IF Y<0

               SET DDXPOUT=1

               QUIT 

 +9       ;Throw away FILE so it can be stuffed back. throw away rest of Template

           IF '$PIECE(Y,U,3)

               SET $PIECE(^(0),U,4)=""

               SET X=0

               FOR 

                   SET X=$ORDER(^(X))

                   if X=""

                       QUIT 

                   KILL ^(X)

 +10      ;'$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

 +11       SET DDXPXTNO=+Y

 +12       QUIT 

 +13      ;

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 

 +5       ;

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