Return to DIAXG1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIAXG1	;SFISC/DCM-EXTRACT FIELDS ;3/2/93  1:36 PM
	;;21.0;VA FileMan;;Dec 28, 1994;
	;Per VHA Directive 10-93-142, this routine should not be modified.
START	K ^UTILITY("DIQ1",$J,DIAX(DILL,"FILE"))
	D DRS
	Q
	;
DRS	S DR="",DIAXDRR="",DIAXDRZ=0
	F DIAX2=0:0 S DIAX2=$O(^DIPT(DIARP,1,DIAXI,"F",DIAX2)) Q:DIAX2'=+DIAX2  I $D(^(DIAX2,0)) S DRX=^(0),DR=DR_+DRX_";",DIAXDR(+DRX)=$P(DRX,U,3),DIAXEXT(+DRX)=$P(DRX,U,5) I $L(DR)>200 D DR S DR="",DIAXDRR=""
	D DR:DR]"" K DIAX2,DIAXDRZ Q
	;
EN	;
DR	I '$D(DIAX(DILL,"MUL")) S DIC=DIAX(DILL,"FILE"),DA=DIAX(DILL,"FE")
	S DIQ(0)="IEN" D EN^DIQ1 K DIQ
	F DIAX2(DILL,"FLD")=0:0 D DR2 Q:DIAX2(DILL,"FLD")'=+DIAX2(DILL,"FLD")  S X=^UTILITY("DIQ1",$J,DIAX(DILL,"FILE"),DIAX(DILL,"FE"),DIAX2(DILL,"FLD"),$S($G(DIAXEXT(DIAX2(DILL,"FLD"))):"E",1:"I")) D FIELD
	D ET
	I '$D(DIAX(DILL,"MUL")) K DA,DIC,DR,DIAXDRR,DIAXDR,DIAXEXT
	K ^UTILITY("DIQ1",$J,DIAX(DILL,"FILE")),DRX
	Q
	;
DR2	S DIAX2(DILL,"FLD")=$O(^UTILITY("DIQ1",$J,DIAX(DILL,"FILE"),DIAX(DILL,"FE"),DIAX2(DILL,"FLD"))) Q:DIAX2(DILL,"FLD")=""
	I $O(^UTILITY("DIQ1",$J,DIAX(DILL,"FILE"),DIAX(DILL,"FE"),DIAX2(DILL,"FLD"),0)) S V("WP")=0,^UTILITY("DIQ1",$J,DIAX(DILL,"FILE"),DIAX(DILL,"FE"),DIAX2(DILL,"FLD"),"I")="wp"
	Q
	;
FIELD	D:$L(DIAXDRR)+$L(X)>235 ET
	Q:'$D(DIAXDR(DIAX2(DILL,"FLD")))
	I DIAXDR(DIAX2(DILL,"FLD"))=".01" S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"X")=X G F2
	S:X[";" ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),DIAXDR(DIAX2(DILL,"FLD")))=X
	S:'$D(V) DIAXDRR=DIAXDRR_DIAXDR(DIAX2(DILL,"FLD"))_"///"_$S(X'[";":X,1:"^S X=^TMP(""DIAX"",$J,"_DIAXET(DILL,"FILE")_","_DIAXDR(DIAX2(DILL,"FLD"))_")")_";"
	D:$D(V)>9 WP
F2	K X,V
	Q
	;
WP	S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),DIAXDR(DIAX2(DILL,"FLD")),"DTO(1)")=^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"GL"),^("DTL")=1
	S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),DIAXDR(DIAX2(DILL,"FLD")),"DFR(1)")=DIAX(DILL,"FGBL")_DIAX(DILL,"FE")_","""_$P($P(^DD(DIAX(DILL,"FILE"),DIAX2(DILL,"FLD"),0),U,4),";")_""",",^("DFL")=1
	S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"WP",0)="",^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"WP",DIAXDR(DIAX2(DILL,"FLD")),0)=""
	Q
	;
ET	I '$D(^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"DR")) S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"DR")=DIAXDRR G ET1
	S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"DR",$G(DIAXDRZ)+1)=DIAXDRR,DIAXDRZ=$G(DIAXDRZ)+1
	;
ET1	S DIAXDRR=""
	Q