Return to DIAXG1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIAXG1.m, revision 1.1

1.1     ! snw         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