| 1 | DIAR ;SFISC/TKW,WISC/CAP-ARCHIVING FUNCTIONS ;7/1/93 4:17 PM
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | G NOKL
|
|---|
| 5 | ;
|
|---|
| 6 | 1 ;;SELECT ENTRIES TO ARCHIVE
|
|---|
| 7 | S DIAR=1 D DIAR^DICRW G Q:Y<0 S %=$P(Y,U,2),(Y,DIARF,DIART)=+Y
|
|---|
| 8 | ;TEMPORARY CHANGE TO SKIP SUB-FILE OPTION--NOT COMPLETE
|
|---|
| 9 | G O
|
|---|
| 10 | G O:'$O(^DD(DIARF,"SB",0))
|
|---|
| 11 | W !!,"IF YOU PLAN TO ARCHIVE DATA ONLY FROM ONE SUB-FILE"
|
|---|
| 12 | W !,"PLEASE IDENTIFY IT HERE. OTHERWISE, JUST PRESS RETURN.",!
|
|---|
| 13 | D SUB^DICRW G Q:$D(DTOUT)!$D(DUOUT),O:'$D(DIA) S DIARF=DIA
|
|---|
| 14 | S DIARF0="D0," F D=1:1 Q:'$D(^DD(DIA,0,"UP")) S DIARF0=DIARF0_"D"_D_",",DIA=^("UP")
|
|---|
| 15 | O S I="" D CHK
|
|---|
| 16 | I '$D(DIARC) D NEW^DIARCALC G Q:'$D(DIARC) G T1
|
|---|
| 17 | I $P(Y(0),U,7)>0 W !!,"There is already an outstanding "_$S(+$P(Y(0),U,17):"extract",1:"archiving")_" activity.",!,"Please finish it or CANCEL it.",$C(7),!! G Q
|
|---|
| 18 | D MRK^DIARU
|
|---|
| 19 | T1 S DIC=DIART,L="]" I $D(DIARF0) S DIARF1=$L(DIARF0,",")-1
|
|---|
| 20 | D EN^DIS I '$P(^DIAR(1.11,DIARC,0),U,7) W $C(7),!!,"NO RECORDS WERE SELECTED TO BE "_$S($D(DIAX):"EXTRACTED",1:"ARCHIVED")_"!!",!,"I AM DELETING THIS ARCHIVING ACTIVITY RECORD!!" S DIK="^DIAR(1.11,",DA=DIARC D ^DIK
|
|---|
| 21 | G Q
|
|---|
| 22 | ;
|
|---|
| 23 | CHK ;IS THERE A VALID SEARCH ?
|
|---|
| 24 | K DIARC,Y(0) S I=0,Y=$S($D(DIARF):DIARF,1:Y)
|
|---|
| 25 | C S I=$O(^DIAR(1.11,"C",+Y,I)) Q:'I S Y(0)=""
|
|---|
| 26 | G C:'$D(^DIAR(1.11,I,0)) G C:$P(^(0),U,8)>89 S Y(0)=^(0)
|
|---|
| 27 | S DIC=$P(Y(0),U,2),DIARC=I,DIARU=$P(Y(0),U,3),DIARP=$P(Y(0),U,4)
|
|---|
| 28 | Q
|
|---|
| 29 | 2 ;;ADD/DELETE SELECTED ENTRIES
|
|---|
| 30 | S DIAR=2 G ENTE^DIARB
|
|---|
| 31 | ;
|
|---|
| 32 | 3 ;;PRINT SELECTED ENTRIES
|
|---|
| 33 | S DIAR=3 G OUT^DIARA
|
|---|
| 34 | ;
|
|---|
| 35 | 4 ;;CREATE FILEGRAM ARCHIVING TEMPLATE
|
|---|
| 36 | S DI=1,DIAR="" G EN^DIFGO
|
|---|
| 37 | ;
|
|---|
| 38 | 5 ;;WRITE ENTRIES TO TEMPORARY STORAGE
|
|---|
| 39 | S DIAR=4 G OUT^DIARA
|
|---|
| 40 | ;
|
|---|
| 41 | ;
|
|---|
| 42 | 6 ;;MOVE ARCHIVED DATA TO PERMANENT STORAGE
|
|---|
| 43 | S DIAR=5 D FILE^DIARU G Q:'$D(DIARC)
|
|---|
| 44 | W !!,"NOTE: This option will 1) print an archive activity report to specified",!,"PRINTER DEVICE and 2) will move archive data to permanent storage to specified",!,"ARCHIVE STORAGE DEVICE."
|
|---|
| 45 | W !!,"Select some type of SEQUENTIAL media, such as SDP, TAPE, or DISK FILE (HFS),",!,"for archival storage.",!
|
|---|
| 46 | S %ZIS("A")="PRINTER DEVICE: ",%ZIS("B")="",%ZIS="NQ" D ^%ZIS G 65:POP S DIARPDEV=$S($D(ION)#2:ION,1:IO),DIARTRM=$S(IO=IO(0):1,1:0)
|
|---|
| 47 | I $D(IOST)#2,IOST]"" S DIARPDEV=DIARPDEV_";"_IOST
|
|---|
| 48 | F DIARX="IOM","IOSL" S:($D(@DIARX)#2&@DIARX) DIARPDEV=DIARPDEV_";"_@DIARX
|
|---|
| 49 | I $D(IO("Q")) S DIARQUED=1
|
|---|
| 50 | S %ZIS="Q",%ZIS("B")="",%ZIS("A")="ARCHIVE STORAGE DEVICE: " D ^%ZIS G 65:POP
|
|---|
| 51 | I IOT'["HFS",IOT'["MT",IOT'["SDP" D 63 I $D(DIRUT)!('Y) D 64 G 65
|
|---|
| 52 | I $D(IO("Q")),DIARTRM U IO(0) W !,$C(7),"SINCE YOU SELECTED QUEUEING, YOU SHOULD SELECT A PRINTER DEVICE",!,"OTHER THAN YOUR TERMINAL!",! G 65
|
|---|
| 53 | D AL I $D(DTOUT)!$D(DIRUT) D 64 G 65
|
|---|
| 54 | I $D(IO("Q")) D G Q
|
|---|
| 55 | . I '$D(DIARQUED),'DIARTRM S DIARQUED=1 U IO(0) W !,$C(7),"SINCE YOU SELECTED QUEUEING, REPORT WILL BE QUEUED ALSO!",!
|
|---|
| 56 | . S ZTRTN="62^DIAR",ZTSAVE("DIARC")="",ZTSAVE("DIAR")="",ZTDESC="Move archived data to permanent storage",ZTSAVE("DIARPDEV")="",ZTSAVE("DIARQUED")=""
|
|---|
| 57 | . D ^%ZTLOAD,HOME^%ZIS Q
|
|---|
| 58 | 62 D ^DIARX
|
|---|
| 59 | S DIARL="F Q:$A(DIARLINE)-32 S DIARLINE=$E(DIARLINE,2,999)"
|
|---|
| 60 | U IO F I=0:0 S I=$O(^DIAR(1.11,DIARC,"D",I)) Q:I'>0 I $D(^(I,0)) S DIARLINE=^(0) X:$E(DIARLINE)[" " DIARL W DIARLINE,!
|
|---|
| 61 | W "#$#",!
|
|---|
| 62 | D 64,OUT^DIARX,UPDATE^DIARU
|
|---|
| 63 | G Q
|
|---|
| 64 | 63 U IO(0) W !,$C(7),"The ARCHIVE STORAGE device selected does not look like a SEQUENTIAL",!,"storage medium.",!
|
|---|
| 65 | K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to continue" D ^DIR
|
|---|
| 66 | I Y U IO(0) W !,"OK.",!
|
|---|
| 67 | Q
|
|---|
| 68 | 64 X $G(^%ZIS("C"))
|
|---|
| 69 | Q
|
|---|
| 70 | 65 ;
|
|---|
| 71 | G UNLK^DIARA
|
|---|
| 72 | ;
|
|---|
| 73 | 7 ;;PURGE STORED ENTRIES
|
|---|
| 74 | D S DIAR=90 G ENTD^DIARA
|
|---|
| 75 | ;
|
|---|
| 76 | 8 ;;CANCEL ARCHIVAL SELECTION
|
|---|
| 77 | S DIAR=99 G ENTC^DIARA
|
|---|
| 78 | ;
|
|---|
| 79 | 9 ;;FIND ARCHIVED ENTRIES
|
|---|
| 80 | S DIC=9.4,DIC(0)="QM",DIC("S")="I $P(^(0),U,2)=""XU""",X="KERNEL" D ^DIC K X,DIC I Y'>0 W !,$C(7),"YOU NEED KERNEL TO RUN THIS OPTION" Q
|
|---|
| 81 | I $G(^DIC(9.4,+Y,"VERSION"))'>7.0 W !,$C(7),"YOU NEED KERNEL V7.1 TO RUN THIS OPTION" Q
|
|---|
| 82 | G ^DIARR
|
|---|
| 83 | ;
|
|---|
| 84 | Q G Q^DIARB
|
|---|
| 85 | ;
|
|---|
| 86 | AL ; archive device label
|
|---|
| 87 | U IO(0) K DIR,DA
|
|---|
| 88 | S DIARXXX=$S(IOT["MT":IO_"ARCHIVE"_";"_DT_";"_DIARC,1:IO)
|
|---|
| 89 | S DIR(0)="1.11,18",DIR("B")=DIARXXX D ^DIR Q:$D(DTOUT)!$D(DUOUT)
|
|---|
| 90 | S DIARXXX=X,DIE=1.11,DA=DIARC,DR="18////^S X=DIARXXX" D ^DIE
|
|---|
| 91 | Q
|
|---|
| 92 | NOKL S DIK="^DOPT(""DIAR""," G GO:$D(^DOPT("DIAR",9))
|
|---|
| 93 | S ^(0)="ARCHIVE OPTION^1.01^" K ^("B")
|
|---|
| 94 | F I=1:1:9 S ^DOPT("DIAR",I,0)=$P($T(@I),";;",2)
|
|---|
| 95 | D IXALL^DIK
|
|---|
| 96 | GO W ! S DIC=DIK,DIC(0)="AEQI" D ^DIC K DIC,DIK
|
|---|
| 97 | I Y'<0 S X=+Y K Y D @X G NOKL
|
|---|
| 98 | W ! G Q^DII
|
|---|
