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 ---[H[J[2J[HDDXP31 4057 printed Sep 23, 2025@20:20:17 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
