File:  [Coherent Logic Development] / freem_fileman / USER / DDXP2.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: DDXP2	;SFISC/DPC-SELECTED FIELDS FOR EXPORT ;10/11/94  14:34
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EN1	;
    5: 	N Y,D,DICS D ^DICRW I Y=-1 G QUIT
    6: 	S Q="""",C=",",DC=0,L=1,DI=DIC,DALL(1)=1 W !
    7: 	D ^DIP2
    8: 	I $D(DDXPFDTM) S DIE="^DIPT(",DA=DDXPFDTM,DR="8///7" D ^DIE
    9: QUIT	;
   10: 	K C,DA,DALL,DC,DI,DIE,DIC,DR,DTOUT,DUOUT,L,Q
   11: 	Q
   12: VALALL	;
   13: 	W !,$C(7),"SORRY.  When choosing export fields, you cannot use ALL to select all fields.",!
   14: 	S Y=0 K X
   15: 	Q
   16: VAL1	;validates raw user input -- X contains user input
   17: 	S DDXPNG=0
   18: 	F DDXPCK=";C",";D",";L",";N",";R",";S",";T",";W",";X" D
   19: 	. I X[DDXPCK S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot add "_DDXPCK_" to the export field specifications.",!
   20: 	. Q
   21: 	F DDXPCK="+","#","*","&","!" D
   22: 	. I $E(X)=DDXPCK S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot choose the "_DDXPCK_" statistical operator when selecting fields for export.",!
   23: 	. Q
   24: 	I $E(X,$L(X))=":" S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot jump to another file when selecting fields for export.",!
   25: 	I X[";""" S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot enter a custom heading when selecting fields for export."
   26: 	K:DDXPNG X K DDXPNG,DDXPCK
   27: 	Q
   28: VAL2	;validates found field -- Y(0) contains 0-node of field DD
   29: 	S DDXPNG=0
   30: 	S %=+$P(Y(0),U,2) I '% G VAL2OUT
   31: 	I $P($G(^DD(%,.01,0)),U,2)["W" S DDXPNG=1 W !!,$C(7),"SORRY.  You cannot choose a word processing field for export.",!
   32: VAL2OUT	K:DDXPNG Y(0) K %,DDXPNG
   33: 	Q
   34: VAL3	;validates expression returned from DICOMP -- S contains expression
   35: 	S DDXPNG=0
   36: 	I S[";W"!(S[";m") S DDXPNG=1 W !!,$C(7),"SORRY.  That response is not acceptable when selecting fields for export.",!
   37: 	K:DDXPNG S K DDXPNG
   38: 	Q

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