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