Return to DIAXG1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIAXG1.m, revision 1.1.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