DICRW1.m

DICRW1 ;SFISC/XAK-SELECT A FILE ;11:06 AM  12 Oct 1999

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

 ;

L ;LIST DD'S

 S DIB(1)=0 S D=8101.1 D C2 G C4:U[X&(Y<0),L:Y<0 ;**CCO/NI 'START WITH WHAT FILE'

C3 S D=8101.2 D C2 G C3:Y<0&(X'[U) ;**CCO/NI  'GO TO WHAT FILE'

ERR I Y<DIB(1),X'[U W $C(7),!,$$EZBLD^DIALOG(1510) G L ;**CCO/NI  START WITH > GO TO

C4 I X[U!'$D(DIC) K DIC Q

 S X=DIB(1),DIB(1)=+Y,Y=X Q

C2 D R1^DICRW D:$D(DDUC) DU S DIC(0)="QEI" D DIC^DICRW K DIAC,DIFILE Q:X[U!'$D(DIC)!(Y=-1)  S:DIB(1)=0 DIB(1)=+Y Q

DU S DIC("S")="I Y'<2 "_DIC("S")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DICRW1   824     printed  Apr 09, 2024@21:52:41                                                                                                                                                                                                       Page 2

DICRW1    ;SFISC/XAK-SELECT A FILE ;11:06 AM  12 Oct 1999

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

L         ;LIST DD'S

 +1       ;**CCO/NI 'START WITH WHAT FILE'

           SET DIB(1)=0

           SET D=8101.1

           DO C2

           if U[X&(Y<0)

               GOTO C4

           if Y<0

               GOTO L

C3        ;**CCO/NI  'GO TO WHAT FILE'

           SET D=8101.2

           DO C2

           if Y<0&(X'[U)

               GOTO C3

ERR       ;**CCO/NI  START WITH > GO TO

           IF Y<DIB(1)

               IF X'[U

                   WRITE $CHAR(7),!,$$EZBLD^DIALOG(1510)

                   GOTO L

C4         IF X[U!'$DATA(DIC)

               KILL DIC

               QUIT 

 +1        SET X=DIB(1)

           SET DIB(1)=+Y

           SET Y=X

           QUIT 

C2         DO R1^DICRW

           if $DATA(DDUC)

               DO DU

           SET DIC(0)="QEI"

           DO DIC^DICRW

           KILL DIAC,DIFILE

           if X[U!'$DATA(DIC)!(Y=-1)

               QUIT 

           if DIB(1)=0

               SET DIB(1)=+Y

           QUIT 

DU         SET DIC("S")="I Y'<2 "_DIC("S")

 +1        QUIT