Return to DIAXU3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIAXU3.m, revision 1.1.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:        ;