Return to DDXP31.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DDXP31.m, revision 1.1

1.1     ! snw         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