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