Return to DIAR.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIAR.m, revision 1.1

1.1     ! snw         1: DIAR   ;SFISC/TKW,WISC/CAP-ARCHIVING FUNCTIONS ;7/1/93  4:17 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             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