File:  [Coherent Logic Development] / freem_fileman / USER / DIAXG2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIAXG2	;SFISC/DCM-EXTRACT SUBFILES ;9/2/94  06:35
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: SUBFILE	F DIAX(DILL,"FE")=0:0 S DIAX(DILL,"FE")=$O(@(DIAX(DILL,"FGBL")_DIAX(DILL,"FE")_")")) Q:DIAX(DILL,"FE")'=+DIAX(DILL,"FE")!($D(DIAXMSG))  D SUBENTRY
    5: 	Q
    6: 	;
    7: SUBENTRY	;
    8: 	N DIAXOUT
    9: 	D DR S DR(DIAX(DILL,"FILE"))=.01
   10: 	S DIAX(DILL,"MUL")=1
   11: 	D ^DIAXGU Q:$D(DIAXMSG)!$G(DIAXOUT)
   12: 	D DR,DRS
   13: 	D ^DIAXU1 G X1:$D(DIAXMSG)
   14: 	D RECURSEM
   15: X1	K DIAX(DILL,"MUL"),DA,DR,DIAXDR,DIAXDRR,DIAXEXT,DIAX2,DRX
   16: 	Q
   17: 	;
   18: DR	K DR S I=0
   19: 	F %=DIAX(DILL,"FILE"):0 Q:'$D(^DD(%,0,"UP"))  S X=^("UP"),Y=$O(^DD(X,"SB",%,0)),DR(X)=Y,DA(%)=DIAX(DILL-I,"FE"),%=X,I=I+1
   20: 	S DA=DIAX(DILL-I,"FE"),DIC=DIAX(DILL-I,"FILE"),DR=DR(%) K DR(%)
   21: 	Q
   22: 	;
   23: DRS	S DR(DIAX(DILL,"FILE"))="",DIAXDRR=""
   24: 	F DIAX2=0:0 S DIAX2=$O(^DIPT(DIARP,1,DIAXI,"F",DIAX2)) Q:DIAX2'=+DIAX2  I $D(^(DIAX2,0)) S DRX=^(0) D
   25: 	. S DR(DIAX(DILL,"FILE"))=DR(DIAX(DILL,"FILE"))_+DRX_";",DIAXDR(+DRX)=$P(DRX,U,3),DIAXEXT(+DRX)=$P(DRX,U,5)
   26: 	. I $L(DR(DIAX(DILL,"FILE")))>200 D EN^DIAXG1 S DR(DIAX(DILL,"FILE"))=""
   27: 	D EN^DIAXG1:DR(DIAX(DILL,"FILE"))]""
   28: 	Q
   29: 	;
   30: RECURSEM	D NEXTLVL^DIAXG
   31: 	Q
   32: 	;
   33: DIAXG3	;
   34: FILE	F DIAX(DILL,"FE")=0:0 D FILE2 Q:DIAX(DILL,"FE")=""!($D(DIAXMSG))  D ENTRY
   35: 	K X
   36: 	Q
   37: 	;
   38: FILE2	S DIAX(DILL,"FE")=$O(@(DIAX(DILL,"FGBL")_""""_DIAX(DILL,"XREF")_""","_DIAX(DILL-1,"FE")_","_DIAX(DILL,"FE")_")"))
   39: 	Q
   40: 	;
   41: ENTRY	S DIAX(DILL,"NAV")=1
   42: 	D ^DIAXGU Q:$D(DIAXMSG)
   43: 	K DIAX(DILL,"NAV")
   44: 	D ^DIAXG1
   45: 	D ^DIAXU1 G X1:$D(DIAXMSG)
   46: 	D RECURSEF
   47: 	Q
   48: 	;
   49: RECURSEF	D NEXTLVL^DIAXG
   50: 	Q

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