| 1 | DIARX ;SFISC/DCM-ARCHIVING FUNCTION, BUILD INDEX ;8/12/98 10:25
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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 | N DIXIEN S DIXIEN=$O(^DD("KEY","AP",DIARIXF,"P",0))
|
|---|
| 7 | I DIXIEN F S DIARDR=$O(^DD("KEY",DIXIEN,2,"BB",DIARDR)) Q:'DIARDR I DIARDR'=.01,$O(^(DIARDR,0))=DIARIXF,$D(^DD(DIARIXF,DIARDR,0)) D IDKEY
|
|---|
| 8 | F S DIARDR=$O(^DD(DIARIXF,0,"ID",DIARDR)) Q:DIARDR'>0 I DIARLINE'[("^"_DIARDR_":"),$D(^DD(DIARIXF,DIARDR,0)) D IDKEY
|
|---|
| 9 | S DIARBLNE=DIARLINE
|
|---|
| 10 | S DIARLINE="$INDEX"_U_DIARIXF_U_$P(^DIC(DIARIXF,0),U)_U_DIARLINE U IO W DIARLINE,!
|
|---|
| 11 | F S DA=$O(^DIBT(DIARIXST,1,DA)) Q:DA'>0 S DIQ(0)="E" D EN^DIQ1
|
|---|
| 12 | F S DIARDA=$O(^DIBT(DIARIXST,1,DIARDA)) Q:DIARDA'>0 D IX1
|
|---|
| 13 | K DIARREC,DIARIXF,DIARIXST,DA,DIARDR,DIARIX,DIARDA,DR,DIARLINE
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | IDKEY ; Save KEY or Identifier data
|
|---|
| 17 | S DIARLINE=DIARLINE_U_DIARDR_":"_$P(^DD(DIARIXF,DIARDR,0),U)
|
|---|
| 18 | S DR=DR_";"_DIARDR Q
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | IX1 S DIARLINE="" F S DIARIX=$O(^UTILITY("DIQ1",$J,DIARIXF,DIARDA,DIARIX)) Q:DIARIX'>0 S DIARLINE=DIARLINE_^(DIARIX,"E")_U
|
|---|
| 22 | W DIARLINE,!
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | OUT I $D(DIARQUED) G QP
|
|---|
| 26 | S IOP=DIARPDEV D ^%ZIS G QP:POP
|
|---|
| 27 | DQ ;print archive activity report
|
|---|
| 28 | 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
|
|---|
| 29 | D HDR,BODY
|
|---|
| 30 | Q
|
|---|
| 31 | HDR W:$Y @IOF W !,"ARCHIVE ACTIVITY REPORT",?IOM-24,DIARXY,?IOM-10,"PAGE: ",DIARPG+1
|
|---|
| 32 | S DIARPG=DIARPG+1,$P(DIARLINE,"-",IOM)="" W !,DIARLINE Q
|
|---|
| 33 | ;
|
|---|
| 34 | BODY W !!,"ARCHIVAL ACTIVITY: ",DIARC,!,"ARCHIVE DEVICE LABEL INFORMATION: ",$P(^DIAR(1.11,DIARC,0),U,19)
|
|---|
| 35 | W !,"PRIMARY ARCHIVED FILE: ",$P($G(^DIC(DIARFI,0)),U)_" (#"_DIARFI_")"
|
|---|
| 36 | W !,"ARCHIVER: ",$P($G(^VA(200,$P(DIARX,U,6),0)),U)
|
|---|
| 37 | W !,"SEARCH CRITERIA: " S DIARU=$P(DIARX,U,3),DIARXZ=0
|
|---|
| 38 | F S DIARXZ=$O(^DIBT(DIARU,"O",DIARXZ)) Q:DIARXZ'>0 Q:'$D(^(DIARXZ,0)) W !,?5,^(0)
|
|---|
| 39 | 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
|
|---|
| 40 | 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
|
|---|
| 41 | W !!,"*** PLEASE KEEP THIS FOR FUTURE REFERENCE ***"
|
|---|
| 42 | I $E(IOST)'="C",$Y W @IOF
|
|---|
| 43 | D ^%ZISC
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | HDRC Q:($Y+1<IOSL)
|
|---|
| 47 | I "C"[$E(IOST) K DIR S DIR(0)="E" D ^DIR Q:$D(DTOUT)!($D(DIRUT))
|
|---|
| 48 | D HDR
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | QP S ZTRTN="DQ^DIARX",ZTSAVE("DIARC")="",ZTDESC="ARCHIVE ACTIVITY REPORT",ZTSAVE("^UTILITY(""DIQ1"",$J,")="",ZTSAVE("DIARBLNE")="",ZTIO=DIARPDEV,ZTDTH=$H
|
|---|
| 52 | D ^%ZTLOAD,HOME^%ZIS
|
|---|
