DDXP1 ;SFISC/DPC-CREATE/EDIT FOREIGN FORMAT ;1/8/93 09:09
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
EN1 ;
K DA S DLAYGO=0
GETFF ;
W !
S DIC="^DIST(.44,",DIC(0)="QEALMZ" D ^DIC K DIC
G:Y=-1 QUIT
S DDXPFMNM=$P(Y,U,2),DDXPFMNO=+Y
I $P(Y(0),U,9) D USEDFF G:'($D(DA)#2) GETFF
EDITFF ;
S:'($D(DA)#2) DA=DDXPFMNO S DDSFILE="^DIST(.44,",DR="[DDXP FF FORM1]"
D ^DDS
QUIT ;
K DDXPFMNM,DDXPFMNO,DA,DR,DDSFILE,Y,DLAYGO,X
Q
USEDFF ;
W !!,DDXPFMNM_" foreign format has been used to create an Export Template."
W !,"Therefore, its definition cannot be changed.",!
S DIR(0)="YA",DIR("A")="Do you want to see the contents of "_DDXPFMNM_" format? ",DIR("B")="NO"
D ^DIR K DIR Q:$D(DIRUT)
I Y W !! S DIC="^DIST(.44,",DA=DDXPFMNO D EN^DIQ K DIC,DA
S DIR(0)="YA",DIR("A")="Do you want to use "_DDXPFMNM_" as the basis for a new format? ",DIR("B")="NO"
D ^DIR K DIR Q:$D(DIRUT)!('Y)
NEWFF S DIC="^DIST(.44,",DIC(0)="QEAL",DIC("A")="Name for new FOREIGN FORMAT: " W !
D ^DIC K DIC Q:$D(DTOUT)!($D(DUOUT))!(X="")
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
S DDXPFMNM=$P(Y,U,2),(DIT("F"),DIT("T"))="^DIST(.44,",DA("F")=DDXPFMNO,(DA("T"),DDXPFMNO)=+Y D EN^DIT0
S DIE="^DIST(.44,",DA=DDXPFMNO,DR="40///0" D ^DIE K DIT,DIE,DR,Y
Q
;
FORMVAL ;
N FLDLM,FIXREC,MSGCNT,ERRMSG,USEQT,MAXLEN,SUBNULL S DDSERROR=0,MSGCNT=1
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)
I FIXREC D
. I FLDLM]"" D
. . S DDSERROR=DDSERROR+1
. . S ERRMSG(MSGCNT)="You cannot specify a record delimiter and",MSGCNT=MSGCNT+1
. . S ERRMSG(MSGCNT)="indicate that record lengths are fixed",MSGCNT=MSGCNT+1
. . S ERRMSG(MSGCNT)="for the same foreign format.",MSGCNT=MSGCNT+1
. . Q
. I USEQT D
. . S DDSERROR=DDSERROR+1
. . S ERRMSG(MSGCNT)="You cannot choose to have non-numeric fields quoted",MSGCNT=MSGCNT+1
. . S ERRMSG(MSGCNT)="when you are exporting fixed length records.",MSGCNT=MSGCNT+1
. . Q
. I MAXLEN>255 D
. . S DDSERROR=DDSERROR+1
. . S ERRMSG(MSGCNT)="You cannot set the Maximum Record Length larger than 255 characters ",MSGCNT=MSGCNT+1
. . S ERRMSG(MSGCNT)="when you are defining a fixed record length format.",MSGCNT=MSGCNT+1
. . Q
. I SUBNULL]"" D
. . S DDSERROR=DDSERROR+1
. . S ERRMSG(MSGCNT)="During fixed length exports, null values will always be exported as nothing.",MSGCNT=MSGCNT+1
. . S ERRMSG(MSGCNT)="So, you cannot specify characters to be substituted for null numeric values.",MSGCNT=MSGCNT+1
. . Q
. Q
I DDSERROR D
. S ERRMSG(MSGCNT)=" ",MSGCNT=MSGCNT+1
. S ERRMSG(MSGCNT)="Please correct "_$S(DDSERROR>1:"these discrepancies.",1:"this discrepancy."),MSGCNT=MSGCNT+1
. S ERRMSG(MSGCNT)="You CANNOT save the form until you correct it!"
. Q
D:DDSERROR MSG^DDSUTL(.ERRMSG)
K:'DDSERROR DDSERROR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDXP1 3225 printed Dec 13, 2024@02:44:08 Page 2
DDXP1 ;SFISC/DPC-CREATE/EDIT FOREIGN FORMAT ;1/8/93 09:09
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
EN1 ;
+1 KILL DA
SET DLAYGO=0
GETFF ;
+1 WRITE !
+2 SET DIC="^DIST(.44,"
SET DIC(0)="QEALMZ"
DO ^DIC
KILL DIC
+3 if Y=-1
GOTO QUIT
+4 SET DDXPFMNM=$PIECE(Y,U,2)
SET DDXPFMNO=+Y
+5 IF $PIECE(Y(0),U,9)
DO USEDFF
if '($DATA(DA)#2)
GOTO GETFF
EDITFF ;
+1 if '($DATA(DA)#2)
SET DA=DDXPFMNO
SET DDSFILE="^DIST(.44,"
SET DR="[DDXP FF FORM1]"
+2 DO ^DDS
QUIT ;
+1 KILL DDXPFMNM,DDXPFMNO,DA,DR,DDSFILE,Y,DLAYGO,X
+2 QUIT
USEDFF ;
+1 WRITE !!,DDXPFMNM_" foreign format has been used to create an Export Template."
+2 WRITE !,"Therefore, its definition cannot be changed.",!
+3 SET DIR(0)="YA"
SET DIR("A")="Do you want to see the contents of "_DDXPFMNM_" format? "
SET DIR("B")="NO"
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+5 IF Y
WRITE !!
SET DIC="^DIST(.44,"
SET DA=DDXPFMNO
DO EN^DIQ
KILL DIC,DA
+6 SET DIR(0)="YA"
SET DIR("A")="Do you want to use "_DDXPFMNM_" as the basis for a new format? "
SET DIR("B")="NO"
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
QUIT
NEWFF SET DIC="^DIST(.44,"
SET DIC(0)="QEAL"
SET DIC("A")="Name for new FOREIGN FORMAT: "
WRITE !
+1 DO ^DIC
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))!(X="")
QUIT
+2 IF '$PIECE(Y,U,3)
WRITE !,$CHAR(7),$PIECE(Y,U,2)_" is already being used.",!,"Please enter a new name for the format.",!
GOTO NEWFF
+3 SET DDXPFMNM=$PIECE(Y,U,2)
SET (DIT("F"),DIT("T"))="^DIST(.44,"
SET DA("F")=DDXPFMNO
SET (DA("T"),DDXPFMNO)=+Y
DO EN^DIT0
+4 SET DIE="^DIST(.44,"
SET DA=DDXPFMNO
SET DR="40///0"
DO ^DIE
KILL DIT,DIE,DR,Y
+5 QUIT
+6 ;
FORMVAL ;
+1 NEW FLDLM,FIXREC,MSGCNT,ERRMSG,USEQT,MAXLEN,SUBNULL
SET DDSERROR=0
SET MSGCNT=1
+2 SET FLDLM=$$GET^DDSVAL(DIE,DA,1)
SET FIXREC=$$GET^DDSVAL(DIE,DA,5)
SET USEQT=$$GET^DDSVAL(DIE,DA,8)
SET MAXLEN=$$GET^DDSVAL(DIE,DA,7)
SET SUBNULL=$$GET^DDSVAL(DIE,DA,11)
+3 IF FIXREC
Begin DoDot:1
+4 IF FLDLM]""
Begin DoDot:2
+5 SET DDSERROR=DDSERROR+1
+6 SET ERRMSG(MSGCNT)="You cannot specify a record delimiter and"
SET MSGCNT=MSGCNT+1
+7 SET ERRMSG(MSGCNT)="indicate that record lengths are fixed"
SET MSGCNT=MSGCNT+1
+8 SET ERRMSG(MSGCNT)="for the same foreign format."
SET MSGCNT=MSGCNT+1
+9 QUIT
End DoDot:2
+10 IF USEQT
Begin DoDot:2
+11 SET DDSERROR=DDSERROR+1
+12 SET ERRMSG(MSGCNT)="You cannot choose to have non-numeric fields quoted"
SET MSGCNT=MSGCNT+1
+13 SET ERRMSG(MSGCNT)="when you are exporting fixed length records."
SET MSGCNT=MSGCNT+1
+14 QUIT
End DoDot:2
+15 IF MAXLEN>255
Begin DoDot:2
+16 SET DDSERROR=DDSERROR+1
+17 SET ERRMSG(MSGCNT)="You cannot set the Maximum Record Length larger than 255 characters "
SET MSGCNT=MSGCNT+1
+18 SET ERRMSG(MSGCNT)="when you are defining a fixed record length format."
SET MSGCNT=MSGCNT+1
+19 QUIT
End DoDot:2
+20 IF SUBNULL]""
Begin DoDot:2
+21 SET DDSERROR=DDSERROR+1
+22 SET ERRMSG(MSGCNT)="During fixed length exports, null values will always be exported as nothing."
SET MSGCNT=MSGCNT+1
+23 SET ERRMSG(MSGCNT)="So, you cannot specify characters to be substituted for null numeric values."
SET MSGCNT=MSGCNT+1
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 IF DDSERROR
Begin DoDot:1
+27 SET ERRMSG(MSGCNT)=" "
SET MSGCNT=MSGCNT+1
+28 SET ERRMSG(MSGCNT)="Please correct "_$SELECT(DDSERROR>1:"these discrepancies.",1:"this discrepancy.")
SET MSGCNT=MSGCNT+1
+29 SET ERRMSG(MSGCNT)="You CANNOT save the form until you correct it!"
+30 QUIT
End DoDot:1
+31 if DDSERROR
DO MSG^DDSUTL(.ERRMSG)
+32 if 'DDSERROR
KILL DDSERROR
+33 QUIT
