File:  [Coherent Logic Development] / freem_fileman / USER / DIAXU3.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: 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>