DDXP5 ;SFISC/DPC-PRINT FOREIGN FORMAT DOC ;12/17/92  10:15
 ;;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 ;
 N SEL,CHOICE,OUT,NOMORE K DIS
 S DIR(0)="SM^1:Only print selected foreign formats;2:Print all foreign formats"
 D ^DIR K DIR Q:$D(DIRUT)  S SEL=Y,OUT=0
 I SEL=1 D  Q:$G(CHOICE)=1
 . S DIC="^DIST(.44,",DIC(0)="QEAM",NOMORE=0
 . F CHOICE=1:1 D  Q:OUT
 . . W ! D ^DIC I Y=-1 S OUT=1 Q
 . . S DIS(CHOICE)="I D0="_+Y
 . . Q
 . K DIC
 . Q
 S DIC="^DIST(.44,",L=0,FLDS="[DDXP FORMAT DOC]",DHD="[DDXP FORMAT DOC HDR]",BY="NAME;S2;C1",FR="" W !
 D EN1^DIP
 K Y,DIRUT
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDXP5   854     printed  Sep 23, 2025@20:20:22                                                                                                                                                                                                        Page 2
DDXP5     ;SFISC/DPC-PRINT FOREIGN FORMAT DOC ;12/17/92  10:15
 +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        NEW SEL,CHOICE,OUT,NOMORE
           KILL DIS
 +2        SET DIR(0)="SM^1:Only print selected foreign formats;2:Print all foreign formats"
 +3        DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               QUIT 
           SET SEL=Y
           SET OUT=0
 +4        IF SEL=1
               Begin DoDot:1
 +5                SET DIC="^DIST(.44,"
                   SET DIC(0)="QEAM"
                   SET NOMORE=0
 +6                FOR CHOICE=1:1
                       Begin DoDot:2
 +7                        WRITE !
                           DO ^DIC
                           IF Y=-1
                               SET OUT=1
                               QUIT 
 +8                        SET DIS(CHOICE)="I D0="_+Y
 +9                        QUIT 
                       End DoDot:2
                       if OUT
                           QUIT 
 +10               KILL DIC
 +11               QUIT 
               End DoDot:1
               if $GET(CHOICE)=1
                   QUIT 
 +12       SET DIC="^DIST(.44,"
           SET L=0
           SET FLDS="[DDXP FORMAT DOC]"
           SET DHD="[DDXP FORMAT DOC HDR]"
           SET BY="NAME;S2;C1"
           SET FR=""
           WRITE !
 +13       DO EN1^DIP
 +14       KILL Y,DIRUT
 +15       QUIT