Annotation of freem_fileman/DIAXU3.m, revision 1.1
1.1 ! snw 1: DIAXU3 ;SFISC/DCM-EXCEPTION REPORT ;6/9/93 3:55 PM
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: EN ;
! 5: S DIPAGE=0,DIAXLINE="",DIAXX=^DIAR(1.11,DIARC,0),DIAXZ1=$P(DIAXX,U,2),DIAXZ2=$P($G(^DIC(DIAXZ1,0)),U),DIAXZ=0
! 6: S Y=DT X ^DD("DD") S DIAXY=Y
! 7: D HDR,BODY,END
! 8: Q
! 9: ;
! 10: HDR W:$Y @IOF W !,"ARCHIVAL ACTIVITY EXCEPTION REPORT",?IOM-24,DIAXY,?IOM-10,"PAGE: ",DIPAGE+1
! 11: S DIPAGE=DIPAGE+1,$P(DIAXLINE,"-",IOM)="" W !,DIAXLINE
! 12: Q
! 13: ;
! 14: BODY W !!,"ARCHIVAL ACTIVITY: ",DIARC,?31,"ARCHIVER: ",$P($G(^VA(200,$P(DIAXX,U,6),0)),U)
! 15: W !!,"THE FOLLOWING RECORDS IN THE '"_DIAXZ2_"' FILE WERE NOT MOVED BY THE EXTRACT TOOL"
! 16: W !!?3,"INTERNAL",?16,$P(^DD(DIAXZ1,.01,0),U),!,"ENTRY NUMBER",!
! 17: F S DIAXZ=$O(^TMP("DIERR",$J,DIAXZ)) Q:DIAXZ'>0 W !,?5,$G(^(DIAXZ,"PARAM",2,0)),?16,$E($G(^TMP("DIERR",$J,DIAXZ,"PARAM",3,0)),1,50)
! 18: W !!,"*** PLEASE KEEP THIS FOR FUTURE REFERENCE ***"
! 19: Q
! 20: ;
! 21: END I $E(IOST)'="C",$Y W @IOF
! 22: D ^%ZISC
! 23: K ^TMP("DIERR",$J),DIAXY,DIAXLINE,DIPAGE,DIAXX,DIAXZ,DIAXZZ,DIR,DIRUT,DTOUT,DUOUT,DIAXZ1,DIAXZ2
! 24: Q
! 25: ;
! 26: HDRC Q:($Y+1<IOSL)
! 27: I "C"[$E(IOST) K DIR S DIR(0)="E" D ^DIR Q:$D(DTOUT)!($D(DIRUT))
! 28: D HDR
! 29: Q
! 30: ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>