Return to DIAXG1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIAXG1	;SFISC/DCM-EXTRACT FIELDS ;3/2/93  1:36 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994;
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: START	K ^UTILITY("DIQ1",$J,DIAX(DILL,"FILE"))
    5: 	D DRS
    6: 	Q
    7: 	;
    8: DRS	S DR="",DIAXDRR="",DIAXDRZ=0
    9: 	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=""
   10: 	D DR:DR]"" K DIAX2,DIAXDRZ Q
   11: 	;
   12: EN	;
   13: DR	I '$D(DIAX(DILL,"MUL")) S DIC=DIAX(DILL,"FILE"),DA=DIAX(DILL,"FE")
   14: 	S DIQ(0)="IEN" D EN^DIQ1 K DIQ
   15: 	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
   16: 	D ET
   17: 	I '$D(DIAX(DILL,"MUL")) K DA,DIC,DR,DIAXDRR,DIAXDR,DIAXEXT
   18: 	K ^UTILITY("DIQ1",$J,DIAX(DILL,"FILE")),DRX
   19: 	Q
   20: 	;
   21: DR2	S DIAX2(DILL,"FLD")=$O(^UTILITY("DIQ1",$J,DIAX(DILL,"FILE"),DIAX(DILL,"FE"),DIAX2(DILL,"FLD"))) Q:DIAX2(DILL,"FLD")=""
   22: 	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"
   23: 	Q
   24: 	;
   25: FIELD	D:$L(DIAXDRR)+$L(X)>235 ET
   26: 	Q:'$D(DIAXDR(DIAX2(DILL,"FLD")))
   27: 	I DIAXDR(DIAX2(DILL,"FLD"))=".01" S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"X")=X G F2
   28: 	S:X[";" ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),DIAXDR(DIAX2(DILL,"FLD")))=X
   29: 	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"))_")")_";"
   30: 	D:$D(V)>9 WP
   31: F2	K X,V
   32: 	Q
   33: 	;
   34: WP	S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),DIAXDR(DIAX2(DILL,"FLD")),"DTO(1)")=^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"GL"),^("DTL")=1
   35: 	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
   36: 	S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"WP",0)="",^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"WP",DIAXDR(DIAX2(DILL,"FLD")),0)=""
   37: 	Q
   38: 	;
   39: ET	I '$D(^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"DR")) S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"DR")=DIAXDRR G ET1
   40: 	S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"DR",$G(DIAXDRZ)+1)=DIAXDRR,DIAXDRZ=$G(DIAXDRZ)+1
   41: 	;
   42: ET1	S DIAXDRR=""
   43: 	Q