| 1 | DDXP1 ;SFISC/DPC-CREATE/EDIT FOREIGN FORMAT ;1/8/93 09:09
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
