File:  [Coherent Logic Development] / freem_fileman / Attic / DDSRUN.m
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Mon Apr 28 14:10:44 2025 UTC (5 weeks, 4 days ago) by snw
Branches: CoherentLogicDevelopment
CVS tags: start
Initial commit

DDSRUN	;SFISC/MKO-RUN A FORM ;11:13 AM  20 Dec 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;Select file
	S DDS1="RUN FORM FROM" D W^DICRW K DDS1 G:Y<0 RUNQ
	G:'$D(@(DIC_"0)")) RUNQ
	;
	;Select form
	W ! S DDSFILE=+Y,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"
	D IX^DIC K DIC,D G:Y<0 RUNQ
	S DR="["_$P(Y,U,2)_"]"
	;
	;Select page
	W ! K DIR S DIR(0)="NOA^1:999.9:1"
	S DIR("A")="Enter number of first page: ",DIR("B")=1
	D ^DIR K DIR G:$D(DIRUT) RUNQ
	K DDSPAGE S:Y'=1 DDSPAGE=Y
	;
REC	;Select record
	W ! S DIC=DDSFILE,DIC(0)="QEAM" D ^DIC K DIC G:Y<0 RUNQ
	S DA=+Y
	K D,DIC,X,Y D ^DDS G REC
	;
RUNQ	K D,DIC,X,Y
	K DDSFILE,DDSPAGE,DA,DR
	K DIRUT,DTOUT,DUOUT
	Q

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