Annotation of freem_fileman/DIAXGI.m, revision 1.1

1.1     ! snw         1: DIAXGI ;SFISC/DCM-EXTRACT INITIALIZATION ;11/10/92  2:56 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994;
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: INIT   S DIAXI=0,DILL=1
        !             5:        D FIRST
        !             6:        Q
        !             7:        ;
        !             8: FIRST  S DIAXI=$O(^DIPT(DIARP,1,DIAXI)) Q:DIAXI'=+DIAXI
        !             9:        S X=^(DIAXI,0)
        !            10:        D FVARS
        !            11:        Q
        !            12:        ;
        !            13: FVARS  S DILL=$P(X,U,2),DIAX(DILL,"FILE")=+X,DIAXET(DILL,"FILE")=$P(X,U,9),(DIAXET(DILL,"PRT"),DIAXET(DIAXET(DILL,"FILE")))=$P(X,U,10)
        !            14:        I DILL=1 S DIAX(DILL,"FE")=DIAXFE
        !            15:        I $P(X,U,4)=1 S DIAX(DILL,"FE")=DIAX(DILL-1,"FE")
        !            16:        S DIAX(DILL,"XREF")=$S($P(X,U,4)=4:$P(X,U,7),1:$P(X,U,4)),%=$P(X,U,5)
        !            17:        I $E(%,$L(%))=":" S DIAX(DILL,"NAV")=1 I $P(X,U,4)=2 S DIAX(DILL,"NAV")=2 D DIRECT K %,Y
        !            18:        I $P(X,U,4)=3 S %=$P(X,U,3),%=$O(^DD(%,"SB",+X,0)),%=^DD(+$P(X,U,3),%,0),%=$P($P(^(0),U,4),";") S:+%'=% %=""""_%_"""" S DIAX(DILL,"FGBL")=DIAX(DILL-1,"FGBL")_DIAX(DILL-1,"FE")_","_%_"," K DIAX(DILL,"NAV") D FGBL Q
        !            19:        S DIAX(DILL,"FGBL")=^DIC(DIAX(DILL,"FILE"),0,"GL") D FGBL
        !            20:        Q
        !            21:        ;
        !            22: DIRECT S DIAX(DILL,"FE")=0,%=$P(%,":")
        !            23:        S:'$D(^DD(DIAX(DILL-1,"FILE"),"B",%)) %=$O(^(%))
        !            24:        S %=$O(^DD(DIAX(DILL-1,"FILE"),"B",%,0))
        !            25:        Q:%'=+%
        !            26:        S Y=$P(^DD(DIAX(DILL-1,"FILE"),%,0),U,4),%("N")=$P(Y,";"),%("P")=$P(Y,";",2) S:+%("N")'=%("N") %("N")=""""_%("N")_""""
        !            27:        I $D(@(DIAX(DILL-1,"FGBL")_DIAX(DILL-1,"FE")_","_%("N")_")")) S Y=@("^("_%("N")_")"),DIAX(DILL,"FE")=$P(Y,U,%("P"))
        !            28:        Q
        !            29:        ;
        !            30: FGBL   S DIAXFI=+$P(X,U,10) I 'DIAXFI Q
        !            31:        I DILL=1 S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"GL")=^DIC(DIAXET(DILL,"FILE"),0,"GL") Q
        !            32:        S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"GL")=^TMP("DIAX",$J,DIAXFI,"GL")_$S(DIAXET(DILL,"FILE")'=DIAXFI:^TMP("DIAX",$J,DIAXFI,"DA")_$S($P(X,U,11)]"":","""_$P($P(X,U,11),";")_""",",1:","),1:"")
        !            33:        S:$D(^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"WP")) ^("DTO(1)")=^("GL") S ^("DA(1)")=DIAXET(DIAXFI,"DA")
        !            34:        I $G(DIAXET(DIAXFI,"DA(1)"))]"" F DIAXII=1:1 Q:'$D(DIAXET(DIAXFI,"DA("_DIAXII_")"))  S ^TMP("DIAX",$J,DIAXET(DILL,"FILE"),"DA("_(DIAXII+1)_")")=DIAXET(DIAXFI,"DA("_DIAXII_")")
        !            35:        K DIAXFI,DIAXII
        !            36:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>