DDXP5.m

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 ---DDXP5   854     printed  Apr 09, 2024@21:47:52                                                                                                                                                                                                        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