DIP23 ;SFISC/XAK-PRINT TEMPLATE ;5/10/90  1:36 PM
 ;;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.
 ;
ED S DA=+Y,DRK=DK K Y
 S DRK=DK,DIE="^DIPT(",DR=".01;3;6" D ^DIE K DR G Q^DIP:$D(Y)
 S DC=0,DI=I(0) I $D(DA),'$D(^DIPT(DA,1)) S D9="",DC(0)=DA,DC(1)=-1 D ^DIP22 S DA=DC(0)
 I $D(DA),$D(^DIPT(DA,1)) D ^DIFGA G Q^DIP:$D(DTOUT),H^DIP3
 S DALL(1)=1 G ^DIP2
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIP23   619     printed  Sep 23, 2025@20:28:51                                                                                                                                                                                                        Page 2
DIP23     ;SFISC/XAK-PRINT TEMPLATE ;5/10/90  1:36 PM
 +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       ;
ED         SET DA=+Y
           SET DRK=DK
           KILL Y
 +1        SET DRK=DK
           SET DIE="^DIPT("
           SET DR=".01;3;6"
           DO ^DIE
           KILL DR
           if $DATA(Y)
               GOTO Q^DIP
 +2        SET DC=0
           SET DI=I(0)
           IF $DATA(DA)
               IF '$DATA(^DIPT(DA,1))
                   SET D9=""
                   SET DC(0)=DA
                   SET DC(1)=-1
                   DO ^DIP22
                   SET DA=DC(0)
 +3        IF $DATA(DA)
               IF $DATA(^DIPT(DA,1))
                   DO ^DIFGA
                   if $DATA(DTOUT)
                       GOTO Q^DIP
                   GOTO H^DIP3
 +4        SET DALL(1)=1
           GOTO ^DIP2