- 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 Feb 19, 2025@00:10:23 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
