| 1 | DDXP31 ;SFISC/DPC-CREATE EXPORT TEMPLATE ;10/14/94  14:56
 | 
|---|
| 2 |  ;;22.0;VA FileMan;;Mar 30, 1999
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 | XPT ;
 | 
|---|
| 5 |  S DDXPOUT=0
 | 
|---|
| 6 |  S DIR(0)="F^2:30",DIR("A")="Enter name for EXPORT Template"
 | 
|---|
| 7 |  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."
 | 
|---|
| 8 |  D ^DIR K DIR
 | 
|---|
| 9 |  I $D(DIRUT) S DDXPOUT=1 Q
 | 
|---|
| 10 |  S DIC="^DIPT(",DIC(0)="XL",DLAYGO=0 W ! D ^DIC K DIC,DLAYGO
 | 
|---|
| 11 |  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
 | 
|---|
| 12 |  S DDXPXTNO=+Y
 | 
|---|
| 13 |  Q
 | 
|---|
| 14 | LENGTH ;
 | 
|---|
| 15 |  W !!,"This template will produce fixed length records."
 | 
|---|
| 16 |  W !,"Enter the length of each field below."
 | 
|---|
| 17 |  W !,"The specified number should be the length in the TARGET file.",!!
 | 
|---|
| 18 |  D GETOUT Q:DDXPOUT
 | 
|---|
| 19 |  S DDXPTLEN=0
 | 
|---|
| 20 |  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"
 | 
|---|
| 21 |  F DDXPFLD=1:1:DDXPTOTF D  I DDXPOUT Q  G LENGTH
 | 
|---|
| 22 |  . I DDXPNOUT(DDXPFLD) S DDXPFLEN(DDXPFLD)=0 Q
 | 
|---|
| 23 |  . S DIR("A")=DDXPFCAP(DDXPFLD),DDXPOUT=0 D ^DIR
 | 
|---|
| 24 |  . I $D(DIRUT) S DDXPOUT=1 Q
 | 
|---|
| 25 |  . S DDXPFLEN(DDXPFLD)=Y,DDXPTLEN=DDXPTLEN+Y
 | 
|---|
| 26 |  . Q
 | 
|---|
| 27 |  K DIR,X,Y
 | 
|---|
| 28 |  Q
 | 
|---|
| 29 | FLDNAME ;
 | 
|---|
| 30 |  W !!,"Enter the name of the fields below in the TARGET file."
 | 
|---|
| 31 |  W !,"If you press <RET>, no name will be used.",!!
 | 
|---|
| 32 |  D GETOUT Q:DDXPOUT
 | 
|---|
| 33 |  S DIR(0)="FO^0:30"
 | 
|---|
| 34 |  S DIR("?")="Enter up to 30 characters as the name of this field in the TARGET file"
 | 
|---|
| 35 |  F DDXPFLD=1:1:DDXPTOTF D  I DDXPOUT=1 Q  G FLDNAME
 | 
|---|
| 36 |  . I DDXPNOUT(DDXPFLD) Q
 | 
|---|
| 37 |  . S DIR("A")=DDXPFCAP(DDXPFLD),DDXPOUT=0 D ^DIR
 | 
|---|
| 38 |  . I $D(DTOUT)!$D(DUOUT) S DDXPOUT=1 Q
 | 
|---|
| 39 |  . S DDXPFFNM(DDXPFLD)=Y
 | 
|---|
| 40 |  . Q
 | 
|---|
| 41 |  K DIR,X,Y
 | 
|---|
| 42 |  Q
 | 
|---|
| 43 | DTYPE ;
 | 
|---|
| 44 |  W !!,"Enter the data types of the fields being exported below.",!!
 | 
|---|
| 45 |  D GETOUT Q:DDXPOUT
 | 
|---|
| 46 |  S DIR(0)=".42,1"
 | 
|---|
| 47 |  F DDXPFLD=1:1:DDXPTOTF D  I DDXPOUT=1 Q  G DTYPE
 | 
|---|
| 48 |  . I DDXPNOUT(DDXPFLD) Q
 | 
|---|
| 49 |  . S DIR("A")=DDXPFCAP(DDXPFLD),DIR("B")=$P(^DI(.81,DDXPDT(DDXPFLD),0),U,1),DDXPOUT=0 D ^DIR
 | 
|---|
| 50 |  . I $D(DIRUT) S DDXPOUT=1 Q
 | 
|---|
| 51 |  . S DDXPDT(DDXPFLD)=+Y
 | 
|---|
| 52 |  . Q
 | 
|---|
| 53 |  K DIR,X,Y
 | 
|---|
| 54 |  Q
 | 
|---|
| 55 | IOM ;
 | 
|---|
| 56 |  S DDXPOUT=0
 | 
|---|
| 57 |  W !!,"Enter the maximum length of a physical record that can be exported.",!,"Enter '^' to stop the creation of an EXPORT template.",!
 | 
|---|
| 58 |  I $D(DDXPTLEN) D
 | 
|---|
| 59 |  . W "The default shown is based on the total lengths of the fields being exported.",!
 | 
|---|
| 60 |  . S DIR("B")=DDXPTLEN+1
 | 
|---|
| 61 |  . Q
 | 
|---|
| 62 | RIOM S DIR(0)=".44,7" D ^DIR K DIR
 | 
|---|
| 63 |  I $D(DTOUT)!$D(DUOUT) S DDXPOUT=1 Q
 | 
|---|
| 64 |  I Y>255,$P(DDXPFMZO,U,6) W !!,$C(7),"The length cannot be greater than 255 when sending fixed length records.",! G RIOM
 | 
|---|
| 65 |  S DDXPIOM=Y
 | 
|---|
| 66 |  Q
 | 
|---|
| 67 | ASKDELM ;
 | 
|---|
| 68 |  S DDXPOUT=0
 | 
|---|
| 69 |  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.",!
 | 
|---|
| 70 |  S DIR(0)=".44,1" D ^DIR K DIR
 | 
|---|
| 71 |  I $D(DUOUT)!$D(DTOUT) S DDXPOUT=1 Q
 | 
|---|
| 72 |  S:X="@" Y=X S DDXPDELM=Y
 | 
|---|
| 73 |  Q
 | 
|---|
| 74 | ASKRDLM ;
 | 
|---|
| 75 |  S DDXPOUT=0
 | 
|---|
| 76 |  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.",!
 | 
|---|
| 77 |  S DIR(0)=".44,2" D ^DIR K DIR
 | 
|---|
| 78 |  I $D(DUOUT)!$D(DTOUT) S DDXPOUT=1 Q
 | 
|---|
| 79 |  S:X="@" Y=X S DDXPRDLM=Y
 | 
|---|
| 80 |  Q
 | 
|---|
| 81 | GETOUT ;To see if user wants to continue.
 | 
|---|
| 82 |  S DDXPOUT=0
 | 
|---|
| 83 |  W "Do you want to continue?"
 | 
|---|
| 84 |  S DIR(0)="Y",DIR("B")="YES"
 | 
|---|
| 85 |  S DIR("?")="If you do not give this information, an EXPORT template will NOT be created."
 | 
|---|
| 86 |  D ^DIR K DIR I $D(DIRUT)!'Y S DDXPOUT=1 Q
 | 
|---|
| 87 |  W !!
 | 
|---|
| 88 |  Q
 | 
|---|