Return to DIV.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIV	;SFISC/GFT-VERIFY FLDS ;6/6/94  2:06 PM
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	K J
	S Q="""",S=";",V=0,P=0,I(0)=DIU,@("(A,J(0))=+$P("_DIU_"0),U,2)")
	I $O(^(0))'>0 W $C(7),"  NO ENTRIES ON FILE!" Q
DIC	S DIC="^DD(A,",DIC(0)="EZ",DIC("W")="W:$P(^(0),U,2) ""  (multiple)"""
	S DIC("S")="S %=$P(^(0),U,2) I %'[""C"",$S('%:1,1:$P(^DD(+%,.01,0),U,2)'[""W"")"
	W !,"VERIFY WHICH "_$P(^DD(A,0),U)_": " R X:DTIME Q:U[X
	I X="ALL" D ALL G Q:$D(DIRUT) I Y D  G Q^DIVR:DQI'>0
	.D FLDS
	.S B=0
	.D NEXTLVL
	.Q
	D ^DIC K DQI,^UTILITY("DIVR",$J)
	I Y<0 W:X?1."?" !?3,"You may enter ALL to verify every field at this level of the file.",! G DIC
	S DR=$P(Y(0),U,2) I DR S J(V)=A,P=+Y,V=V+1,A=+DR,I(V)=$P($P(Y(0),U,4),S,1) S:+I(V)'=I(V) I(V)=Q_I(V)_Q G DIC
1	F T="N","D","P","S","V","F" Q:DR[T
	F W="FREE TEXT","SET OF CODES","DATE","NUMERIC","POINTER","VARIABLE POINTER","K" I T[$E(W) S:W="K" W="MUMPS" W "   ",W
	K DA S DIVZ=$P(Y(0),U,3),DDC=$P(Y(0),U,5,99),(DIFLD,DA)=+Y
	G ^DIVR
	;
Q	K DIR,DIRUT,N,P,Q,S,V,C
	Q
	;
ALL	S DIR(0)="Y",DIR("??")="^D H^DIV"
	S DIR("A")="DO YOU MEAN ALL THE FIELDS IN THE FILE"
	D ^DIR K DIR S X="ALL"
	Q
	;
FLDS	S DQI=0 F  S DQI=$O(^DD(A,DQI)) Q:DQI'>0  S Y=DQI,Y(0)=^(Y,0),DR=$P(Y(0),U,2) D
	.I 'DR,DR'["C" W !!!,"--",$P(Y(0),U),"--" D 1 Q
	Q
NEXTLVL	;
	F  S (B,C)=$O(^DD(A,"SB",B)) Q:B'>0  D
	.S DIC="^DD(A,",DIC(0)="Z",X=$O(^DD(A,"SB",B,"")) D ^DIC Q:Y'>0
	.S DR=$P(Y(0),U,2),J(V)=A,P=+Y,V=V+1,I(V)=$P($P(Y(0),U,4),S,1) S:+I(V)'=I(V) I(V)=Q_I(V)_Q
	.I $P(^DD(+DR,.01,0),U,2)["W" Q
	.D NEXTLVL2
	Q
NEXTLVL2	;
	N A,B S A=C,B=0
	D FLDS
	D RECURSE
	K J(V),I(V) S V=V-1
	Q
RECURSE	;
	D NEXTLVL
	Q
H	W !!?5,"YES means that every field at this level in the file will"
	W !?5,"be checked to see if it conforms to the input transform."
	W !!?5,"NO means that ALL will be used to lookup a field in the"
	W !?5,"file which begins with the letters ALL, e.g., ALLERGIES."
	Q