source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSRUN.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1DDSRUN ;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)
21PAGE 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 ;
27REC ;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 ;
38RUNQ ;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
Note: See TracBrowser for help on using the repository browser.