DIFGA1.m

DIFGA1 ;SFISC/XAK,DCM-FILEGRAM TEMPLATES ;2/27/99  12:35

 ;;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.

 ;

Q W:$D(DTOUT) $C(7)

 K Y,C,L,DM,DQI,DA,DICOMP,DICOMPX,I,J,S,DIL,DK

 K D,DIFG,DC,DICS,DP,DU,DXS,DL,DJ,DINS,DIFGLINK

 K DIAXLOC,DIAXMSG,DIAXGL,DIAXF,^UTILITY("DIFG",$J),DJ1,DIAXEF,DIAXDL,DIAXDI,DIAXFILE,DIAXFNO

 K DIAXDICA,DIAXNP,DIAXZ,DIAXDK,DTOUT,DUOUT,DIRUT

 D:$D(DIAX) Q1^DIAXMS

 Q

 ;

INIT K ^UTILITY("DIFG",$J)

 S (L,DL)=1,(I(0),DI)=DIC,(DK,J(0))=+$P(@(DI_"0)"),U,2)

 S DINS="",(DC,DJ,C,C(0),DIL)=0 Q:'$D(DIAX)

 ;

INET K DIC

 S DIC=1,DIC(0)="AEQZ",DIC("S")="I Y'<2,+Y'="_DK_" S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %",DIC("A")="DESTINATION FILE: " D ^DIC Q:Y'>0

 S (DIAXF,DIAXFILE,DIAXFNO,DIAXDL(DL),DIAXDK(DK))=+Y,DIAXGL=$E(^DIC(+Y,0,"GL"),2,99),DIAXEF=Y(0,0),DIAXLOC(DIAXFILE)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIFGA1   1067     printed  Dec 13, 2024@02:47:45                                                                                                                                                                                                      Page 2

DIFGA1    ;SFISC/XAK,DCM-FILEGRAM TEMPLATES ;2/27/99  12:35

 +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       ;

Q          if $DATA(DTOUT)

               WRITE $CHAR(7)

 +1        KILL Y,C,L,DM,DQI,DA,DICOMP,DICOMPX,I,J,S,DIL,DK

 +2        KILL D,DIFG,DC,DICS,DP,DU,DXS,DL,DJ,DINS,DIFGLINK

 +3        KILL DIAXLOC,DIAXMSG,DIAXGL,DIAXF,^UTILITY("DIFG",$JOB),DJ1,DIAXEF,DIAXDL,DIAXDI,DIAXFILE,DIAXFNO

 +4        KILL DIAXDICA,DIAXNP,DIAXZ,DIAXDK,DTOUT,DUOUT,DIRUT

 +5        if $DATA(DIAX)

               DO Q1^DIAXMS

 +6        QUIT 

 +7       ;

INIT       KILL ^UTILITY("DIFG",$JOB)

 +1        SET (L,DL)=1

           SET (I(0),DI)=DIC

           SET (DK,J(0))=+$PIECE(@(DI_"0)"),U,2)

 +2        SET DINS=""

           SET (DC,DJ,C,C(0),DIL)=0

           if '$DATA(DIAX)

               QUIT 

 +3       ;

INET       KILL DIC

 +1        SET DIC=1

           SET DIC(0)="AEQZ"

           SET DIC("S")="I Y'<2,+Y'="_DK_" S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %"

           SET DIC("A")="DESTINATION FILE: "

           DO ^DIC

           if Y'>0

               QUIT 

 +2        SET (DIAXF,DIAXFILE,DIAXFNO,DIAXDL(DL),DIAXDK(DK))=+Y

           SET DIAXGL=$EXTRACT(^DIC(+Y,0,"GL"),2,99)

           SET DIAXEF=Y(0,0)

           SET DIAXLOC(DIAXFILE)=""

 +3        QUIT