DIP23.m

DIP23 ;SFISC/XAK-PRINT TEMPLATE ;5/10/90  1:36 PM

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

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

DIP23     ;SFISC/XAK-PRINT TEMPLATE ;5/10/90  1:36 PM

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

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