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