Return to DDXP1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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