File:  [Coherent Logic Development] / freem_fileman / USER / DDSRUN.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDSRUN	;SFISC/MKO-RUN A FORM ;11:13 AM  20 Dec 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;Select file
    5: 	S DDS1="RUN FORM FROM" D W^DICRW K DDS1 G:Y<0 RUNQ
    6: 	G:'$D(@(DIC_"0)")) RUNQ
    7: 	;
    8: 	;Select form
    9: 	W ! S DDSFILE=+Y,DIC=.403,DIC(0)="QEA",D="F"_+Y
   10: 	S DIC("S")="I $P(^(0),U,8)=+DDSFILE"
   11: 	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"
   12: 	D IX^DIC K DIC,D G:Y<0 RUNQ
   13: 	S DR="["_$P(Y,U,2)_"]"
   14: 	;
   15: 	;Select page
   16: 	W ! K DIR S DIR(0)="NOA^1:999.9:1"
   17: 	S DIR("A")="Enter number of first page: ",DIR("B")=1
   18: 	D ^DIR K DIR G:$D(DIRUT) RUNQ
   19: 	K DDSPAGE S:Y'=1 DDSPAGE=Y
   20: 	;
   21: REC	;Select record
   22: 	W ! S DIC=DDSFILE,DIC(0)="QEAM" D ^DIC K DIC G:Y<0 RUNQ
   23: 	S DA=+Y
   24: 	K D,DIC,X,Y D ^DDS G REC
   25: 	;
   26: RUNQ	K D,DIC,X,Y
   27: 	K DDSFILE,DDSPAGE,DA,DR
   28: 	K DIRUT,DTOUT,DUOUT
   29: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>