Return to DDXP1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

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

1.1     ! snw         1: DDXP1  ;SFISC/DPC-CREATE/EDIT FOREIGN FORMAT ;1/8/93  09:09
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: EN1    ;
        !             5:        K DA S DLAYGO=0
        !             6: GETFF  ;
        !             7:        W !
        !             8:        S DIC="^DIST(.44,",DIC(0)="QEALMZ" D ^DIC K DIC
        !             9:        G:Y=-1 QUIT
        !            10:        S DDXPFMNM=$P(Y,U,2),DDXPFMNO=+Y
        !            11:        I $P(Y(0),U,9) D USEDFF G:'($D(DA)#2) GETFF
        !            12: EDITFF ;
        !            13:        S:'($D(DA)#2) DA=DDXPFMNO S DDSFILE="^DIST(.44,",DR="[DDXP FF FORM1]"
        !            14:        D ^DDS
        !            15: QUIT   ;
        !            16:        K DDXPFMNM,DDXPFMNO,DA,DR,DDSFILE,Y,DLAYGO,X
        !            17:        Q
        !            18: USEDFF ;
        !            19:        W !!,DDXPFMNM_" foreign format has been used to create an Export Template."
        !            20:        W !,"Therefore, its definition cannot be changed.",!
        !            21:        S DIR(0)="YA",DIR("A")="Do you want to see the contents of "_DDXPFMNM_" format? ",DIR("B")="NO"
        !            22:        D ^DIR K DIR Q:$D(DIRUT)
        !            23:        I Y W !! S DIC="^DIST(.44,",DA=DDXPFMNO D EN^DIQ K DIC,DA
        !            24:        S DIR(0)="YA",DIR("A")="Do you want to use "_DDXPFMNM_" as the basis for a new format? ",DIR("B")="NO"
        !            25:        D ^DIR K DIR Q:$D(DIRUT)!('Y)
        !            26: NEWFF  S DIC="^DIST(.44,",DIC(0)="QEAL",DIC("A")="Name for new FOREIGN FORMAT: " W !
        !            27:        D ^DIC K DIC Q:$D(DTOUT)!($D(DUOUT))!(X="")
        !            28:        I '$P(Y,U,3) W !,$C(7),$P(Y,U,2)_" is already being used.",!,"Please enter a new name for the format.",! G NEWFF
        !            29:        S DDXPFMNM=$P(Y,U,2),(DIT("F"),DIT("T"))="^DIST(.44,",DA("F")=DDXPFMNO,(DA("T"),DDXPFMNO)=+Y D EN^DIT0
        !            30:        S DIE="^DIST(.44,",DA=DDXPFMNO,DR="40///0" D ^DIE K DIT,DIE,DR,Y
        !            31:        Q
        !            32:        ;
        !            33: FORMVAL        ;
        !            34:        N FLDLM,FIXREC,MSGCNT,ERRMSG,USEQT,MAXLEN,SUBNULL S DDSERROR=0,MSGCNT=1
        !            35:        S FLDLM=$$GET^DDSVAL(DIE,DA,1),FIXREC=$$GET^DDSVAL(DIE,DA,5),USEQT=$$GET^DDSVAL(DIE,DA,8),MAXLEN=$$GET^DDSVAL(DIE,DA,7),SUBNULL=$$GET^DDSVAL(DIE,DA,11)
        !            36:        I FIXREC D
        !            37:        . I FLDLM]"" D
        !            38:        . . S DDSERROR=DDSERROR+1
        !            39:        . . S ERRMSG(MSGCNT)="You cannot specify a record delimiter and",MSGCNT=MSGCNT+1
        !            40:        . . S ERRMSG(MSGCNT)="indicate that record lengths are fixed",MSGCNT=MSGCNT+1
        !            41:        . . S ERRMSG(MSGCNT)="for the same foreign format.",MSGCNT=MSGCNT+1
        !            42:        . . Q
        !            43:        . I USEQT D
        !            44:        . . S DDSERROR=DDSERROR+1
        !            45:        . . S ERRMSG(MSGCNT)="You cannot choose to have non-numeric fields quoted",MSGCNT=MSGCNT+1
        !            46:        . . S ERRMSG(MSGCNT)="when you are exporting fixed length records.",MSGCNT=MSGCNT+1
        !            47:        . . Q
        !            48:        . I MAXLEN>255 D
        !            49:        . . S DDSERROR=DDSERROR+1
        !            50:        . . S ERRMSG(MSGCNT)="You cannot set the Maximum Record Length larger than 255 characters ",MSGCNT=MSGCNT+1
        !            51:        . . S ERRMSG(MSGCNT)="when you are defining a fixed record length format.",MSGCNT=MSGCNT+1
        !            52:        . . Q
        !            53:        . I SUBNULL]"" D
        !            54:        . . S DDSERROR=DDSERROR+1
        !            55:        . . S ERRMSG(MSGCNT)="During fixed length exports, null values will always be exported as nothing.",MSGCNT=MSGCNT+1
        !            56:        . . S ERRMSG(MSGCNT)="So, you cannot specify characters to be substituted for null numeric values.",MSGCNT=MSGCNT+1
        !            57:        . . Q
        !            58:        . Q
        !            59:        I DDSERROR D
        !            60:        . S ERRMSG(MSGCNT)=" ",MSGCNT=MSGCNT+1
        !            61:        . S ERRMSG(MSGCNT)="Please correct "_$S(DDSERROR>1:"these discrepancies.",1:"this discrepancy."),MSGCNT=MSGCNT+1
        !            62:        . S ERRMSG(MSGCNT)="You CANNOT save the form until you correct it!"
        !            63:        . Q
        !            64:        D:DDSERROR MSG^DDSUTL(.ERRMSG)
        !            65:        K:'DDSERROR DDSERROR
        !            66:        Q