source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDXP31.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1DDXP31 ;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.
4XPT ;
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
14LENGTH ;
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
29FLDNAME ;
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
43DTYPE ;
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
55IOM ;
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
62RIOM 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
67ASKDELM ;
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
74ASKRDLM ;
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
81GETOUT ;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
Note: See TracBrowser for help on using the repository browser.