| 1 | DDSRUN ;SFISC/MKO-RUN A FORM ;21SEP2006
|
|---|
| 2 | ;;22.0;VA FileMan;**151**;Mar 30, 1999;Build 10
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;Select file (DDSFILE)
|
|---|
| 6 | S DDS1="RUN FORM FROM" D W^DICRW K DDS1 G:Y<0 RUNQ
|
|---|
| 7 | G:'$D(@(DIC_"0)")) RUNQ
|
|---|
| 8 | K DDSFILE S DDSFILE=+Y
|
|---|
| 9 | ;
|
|---|
| 10 | ;Select form (DDSRUNDR)
|
|---|
| 11 | K DIC
|
|---|
| 12 | S DIC=.403,DIC(0)="QEA",D="F"_+Y
|
|---|
| 13 | S DIC("S")="I $P(^(0),U,8)=+DDSFILE"
|
|---|
| 14 | 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"
|
|---|
| 15 | W ! D IX^DIC K DIC,D G:Y<0 RUNQ
|
|---|
| 16 | S DDSRUNDR=+Y
|
|---|
| 17 | ;
|
|---|
| 18 | I '$$COMPILED^DDS0(DDSRUNDR) D EN^DDSZ(DDSRUNDR) G:$G(DIERR) RUNQ
|
|---|
| 19 | ;
|
|---|
| 20 | ;Select page (DDSPAGE)
|
|---|
| 21 | PAGE K DIR S Y=$O(^DIST(.403,DDSRUNDR,40,0)) I '$O(^(Y)) S DDSPAGE=1 G REC
|
|---|
| 22 | S DIR(0)="NOA^1:999.9:1"
|
|---|
| 23 | S DIR("A")="Enter number of first page: ",DIR("B")=1
|
|---|
| 24 | W ! D ^DIR K DIR G:$D(DIRUT) RUNQ
|
|---|
| 25 | K DDSPAGE S:Y'=1 DDSPAGE=Y
|
|---|
| 26 | ;
|
|---|
| 27 | REC ;Select record (DA)
|
|---|
| 28 | K DA
|
|---|
| 29 | I '$P(^DIST(.403,DDSRUNDR,0),U,10) D G:DA<0 RUNQ
|
|---|
| 30 | . S DIC=DDSFILE,DIC(0)="QEALM"
|
|---|
| 31 | . W ! D ^DIC K DIC
|
|---|
| 32 | . S DA=+Y
|
|---|
| 33 | K D,DIC,X,Y
|
|---|
| 34 | ;
|
|---|
| 35 | ;Invoke form
|
|---|
| 36 | K DR S DR=DDSRUNDR D ^DDS G:$D(DA) REC
|
|---|
| 37 | ;
|
|---|
| 38 | RUNQ ;Clean up and quit
|
|---|
| 39 | I $D(DIERR) W !,$C(7) D MSG^DIALOG("BW")
|
|---|
| 40 | K D,DIC,X,Y
|
|---|
| 41 | K DDSFILE,DDSPAGE,DDSRUNDR,DA,DR
|
|---|
| 42 | K DIRUT,DTOUT,DUOUT
|
|---|
| 43 | Q
|
|---|
