DDSRUN.m

DDSRUN ;SFISC/MKO-RUN A FORM ;21SEP2006

 ;;22.0;VA FileMan;**151**;Mar 30, 1999;Build 10

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 ;Select file (DDSFILE)

 S DDS1="RUN FORM FROM" D W^DICRW K DDS1 G:Y<0 RUNQ

 G:'$D(@(DIC_"0)")) RUNQ

 K DDSFILE S DDSFILE=+Y

 ;

 ;Select form (DDSRUNDR)

 K DIC

 S DIC=.403,DIC(0)="QEA",D="F"_+Y

 S DIC("S")="I $P(^(0),U,8)=+DDSFILE"

 I DUZ(0)'="@" S DIC("S")=DIC("S")_" N DDSI F DDSI=1:1:$L($P(^(0),U,2)) I DUZ(0)[$E($P(^(0),U,2),DDSI) Q"

 W ! D IX^DIC K DIC,D G:Y<0 RUNQ

 S DDSRUNDR=+Y

 ;

 I '$$COMPILED^DDS0(DDSRUNDR) D EN^DDSZ(DDSRUNDR) G:$G(DIERR) RUNQ

 ;

 ;Select page (DDSPAGE)

PAGE K DIR S Y=$O(^DIST(.403,DDSRUNDR,40,0)) I '$O(^(Y)) S DDSPAGE=1 G REC

 S DIR(0)="NOA^1:999.9:1"

 S DIR("A")="Enter number of first page: ",DIR("B")=1

 W ! D ^DIR K DIR G:$D(DIRUT) RUNQ

 K DDSPAGE S:Y'=1 DDSPAGE=Y

 ;

REC ;Select record (DA)

 K DA

 I '$P(^DIST(.403,DDSRUNDR,0),U,10) D  G:DA<0 RUNQ

 . S DIC=DDSFILE,DIC(0)="QEALM"

 . W ! D ^DIC K DIC

 . S DA=+Y

 K D,DIC,X,Y

 ;

 ;Invoke form

 K DR S DR=DDSRUNDR D ^DDS G:$D(DA) REC

 ;

RUNQ ;Clean up and quit

 I $D(DIERR) W !,$C(7) D MSG^DIALOG("BW")

 K D,DIC,X,Y

 K DDSFILE,DDSPAGE,DDSRUNDR,DA,DR

 K DIRUT,DTOUT,DUOUT

 Q

DDSRUN    ;SFISC/MKO-RUN A FORM ;21SEP2006

 +1       ;;22.0;VA FileMan;**151**;Mar 30, 1999;Build 10

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ;Select file (DDSFILE)

 +5        SET DDS1="RUN FORM FROM"

           DO W^DICRW

           KILL DDS1

           IF Y<0

               GOTO RUNQ

 +6        IF '$DATA(@(DIC_"0)"))

               GOTO RUNQ

 +7        KILL DDSFILE

           SET DDSFILE=+Y

 +8       ;

 +9       ;Select form (DDSRUNDR)

 +10       KILL DIC

 +11       SET DIC=.403

           SET DIC(0)="QEA"

           SET D="F"_+Y

 +12       SET DIC("S")="I $P(^(0),U,8)=+DDSFILE"

 +13       IF DUZ(0)'="@"

               SET DIC("S")=DIC("S")_" N DDSI F DDSI=1:1:$L($P(^(0),U,2)) I DUZ(0)[$E($P(^(0),U,2),DDSI) Q"

 +14       WRITE !

           DO IX^DIC

           KILL DIC,D

           IF Y<0

               GOTO RUNQ

 +15       SET DDSRUNDR=+Y

 +16      ;

 +17       IF '$$COMPILED^DDS0(DDSRUNDR)

               DO EN^DDSZ(DDSRUNDR)

               IF $GET(DIERR)

                   GOTO RUNQ

 +18      ;

 +19      ;Select page (DDSPAGE)

PAGE       KILL DIR

           SET Y=$ORDER(^DIST(.403,DDSRUNDR,40,0))

           IF '$ORDER(^(Y))

               SET DDSPAGE=1

               GOTO REC

 +1        SET DIR(0)="NOA^1:999.9:1"

 +2        SET DIR("A")="Enter number of first page: "

           SET DIR("B")=1

 +3        WRITE !

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO RUNQ

 +4        KILL DDSPAGE

           IF Y'=1

               SET DDSPAGE=Y

 +5       ;

REC       ;Select record (DA)

 +1        KILL DA

 +2        IF '$PIECE(^DIST(.403,DDSRUNDR,0),U,10)

               Begin DoDot:1

 +3                SET DIC=DDSFILE

                   SET DIC(0)="QEALM"

 +4                WRITE !

                   DO ^DIC

                   KILL DIC

 +5                SET DA=+Y

               End DoDot:1

               IF DA<0

                   GOTO RUNQ

 +6        KILL D,DIC,X,Y

 +7       ;

 +8       ;Invoke form

 +9        KILL DR

           SET DR=DDSRUNDR

           DO ^DDS

           IF $DATA(DA)

               GOTO REC

 +10      ;

RUNQ      ;Clean up and quit

 +1        IF $DATA(DIERR)

               WRITE !,$CHAR(7)

               DO MSG^DIALOG("BW")

 +2        KILL D,DIC,X,Y

 +3        KILL DDSFILE,DDSPAGE,DDSRUNDR,DA,DR

 +4        KILL DIRUT,DTOUT,DUOUT

 +5        QUIT