Return to DIAXGI.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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