Return to DIARX.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIARX.m, revision 1.1

1.1     ! snw         1: DIARX  ;SFISC/DCM-ARCHIVING FUNCTION, BUILD INDEX ;4/8/93  8:01 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: IX     K ^UTILITY("DIQ1",$J) N DIC
        !             5:        S DIARREC=^DIAR(1.11,DIARC,0),(DIARIXF,DIC)=$P(DIARREC,U,2),DIARIXST=$P(DIARREC,U,3),(DA,DIARDR,DIARIX,DIARDA)="",DR=".01",DIARLINE=.01_":"_$P(^DD(DIARIXF,.01,0),U)
        !             6:        F  S DIARDR=$O(^DD(DIARIXF,0,"ID",DIARDR)) Q:DIARDR'>0  I $D(^DD(DIARIXF,DIARDR,0)) S DIARLINE=DIARLINE_U_DIARDR_":"_$P(^(0),U),DR=DR_";"_DIARDR
        !             7:        S DIARBLNE=DIARLINE,DIARLINE="$INDEX"_U_DIARIXF_U_$P(^DIC(DIARIXF,0),U)_U_DIARLINE U IO W DIARLINE,!
        !             8:        F  S DA=$O(^DIBT(DIARIXST,1,DA)) Q:DA'>0  S DIQ(0)="E" D EN^DIQ1
        !             9:        F  S DIARDA=$O(^DIBT(DIARIXST,1,DIARDA)) Q:DIARDA'>0  D IX1
        !            10:        K DIARREC,DIARIXF,DIARIXST,DA,DIARDR,DIARIX,DIARDA,DR,DIARLINE
        !            11:        Q
        !            12:        ;
        !            13: IX1    S DIARLINE="" F  S DIARIX=$O(^UTILITY("DIQ1",$J,DIARIXF,DIARDA,DIARIX)) Q:DIARIX'>0  S DIARLINE=DIARLINE_^(DIARIX,"E")_U
        !            14:        W DIARLINE,!
        !            15:        Q
        !            16:        ;
        !            17: OUT    I $D(DIARQUED) G QP
        !            18:        S IOP=DIARPDEV D ^%ZIS G QP:POP
        !            19: DQ     ;print archive activity report
        !            20:        S DIARPG=0,DIARLINE="",DIARX=^DIAR(1.11,DIARC,0),DIARFI=$P(DIARX,U,2) U IO S Y=DT X ^DD("DD") S DIARXY=Y
        !            21:        D HDR,BODY
        !            22:        Q
        !            23: HDR    W:$Y @IOF W !,"ARCHIVE ACTIVITY REPORT",?IOM-24,DIARXY,?IOM-10,"PAGE: ",DIARPG+1
        !            24:        S DIARPG=DIARPG+1,$P(DIARLINE,"-",IOM)="" W !,DIARLINE Q
        !            25:        ;
        !            26: BODY   W !!,"ARCHIVAL ACTIVITY: ",DIARC,!,"ARCHIVE DEVICE LABEL INFORMATION: ",$P(^DIAR(1.11,DIARC,0),U,19)
        !            27:        W !,"PRIMARY ARCHIVED FILE: ",$P($G(^DIC(DIARFI,0)),U)_" (#"_DIARFI_")"
        !            28:        W !,"ARCHIVER: ",$P($G(^VA(200,$P(DIARX,U,6),0)),U)
        !            29:        W !,"SEARCH CRITERIA: " S DIARU=$P(DIARX,U,3),DIARXZ=0
        !            30:        F  S DIARXZ=$O(^DIBT(DIARU,"O",DIARXZ)) Q:DIARXZ'>0  Q:'$D(^(DIARXZ,0))  W !,?5,^(0)
        !            31:        W !!,"INDEX INFORMATION: ",! S (DIARTAB,DIARFLD)=0 F DIARXZ=1:1 S DIARFLD=$P($P(DIARBLNE,U,DIARXZ),":",2) Q:DIARFLD=""  W DIARFLD S DIARTAB=DIARTAB+25 W ?DIARTAB
        !            32:        F DIARXZ=0:0 S DIARXZ=$O(^UTILITY("DIQ1",$J,DIARFI,DIARXZ)) Q:DIARXZ'>0  D HDRC Q:$D(DTOUT)!$D(DIRUT)  W ! S DIARTAB=0 F  S DIARFLD=$O(^UTILITY("DIQ1",$J,DIARFI,DIARXZ,DIARFLD)) Q:DIARFLD'>0  W ^(DIARFLD,"E") S DIARTAB=DIARTAB+25 W ?DIARTAB
        !            33:        W !!,"*** PLEASE KEEP THIS FOR FUTURE REFERENCE ***"
        !            34:        I $E(IOST)'="C",$Y W @IOF
        !            35:        D ^%ZISC
        !            36:        Q
        !            37:        ;
        !            38: HDRC   Q:($Y+1<IOSL)
        !            39:        I "C"[$E(IOST) K DIR S DIR(0)="E" D ^DIR Q:$D(DTOUT)!($D(DIRUT))
        !            40:        D HDR
        !            41:        Q
        !            42:        ;
        !            43: QP     S ZTRTN="DQ^DIARX",ZTSAVE("DIARC")="",ZTDESC="ARCHIVE ACTIVITY REPORT",ZTSAVE("^UTILITY(""DIQ1"",$J,")="",ZTSAVE("DIARBLNE")="",ZTIO=DIARPDEV,ZTDTH=$H
        !            44:        D ^%ZTLOAD,HOME^%ZIS