freem_fileman/USER/DDXP31.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DDXP31.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

1: DDXP31 ;SFISC/DPC-CREATE EXPORT TEMPLATE ;10/14/94 14:56 2: ;;21.0;VA FileMan;;Dec 28, 1994 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