Return to DIARR.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIARR.m, revision 1.1

1.1     ! snw         1: DIARR  ;SFISC/DCM-ARCHIVING FUNCTION, RETRIEVAL OF ARCHIVED RECORD ;3/24/93  3:20 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: START  W !!,"This option will scan your archived file and will attempt to retrieve entries"
        !             5:        W !,"that match the name (.01) field and/or the identifier field(s) of the archived",!,"file."
        !             6:        W !!,"Magnetic tapes should be opened with variable length records."
        !             7:        ;
        !             8: INIT   S DIARX="F  U DIARIO R DIARL Q:DIARL]""""&($A(DIARL)'=13)  "
        !             9:        D HOME^%ZIS S DIOF=IOF,DIOSL=IOSL
        !            10:        D DT^DICRW
        !            11:        K ^TMP("DIAR",$J)
        !            12:        S (DIARREQ,DIAROUT,DIARZ,DIAREOF,DIARMTCH,DIARFGEN,DIARPG,DIARRCT,DIARZID,DIARZL,DIARZ1,DIARZ2,DIARX1,DIARY,DIARNM,DIARRCT,DIARFND,DIARRHP)=0,DIARLINE=""
        !            13:        ;
        !            14: SEQDEV S %ZIS("A")="SEQUENTIAL ARCHIVE DEVICE: ",%ZIS("HFSMODE")="R" D ^%ZIS G EOJ:POP
        !            15:        I IOT'["MT",IOT'["SDP",IOT'["HFS" D ^%ZISC W !,$C(7),"This has to be a sequential device." G SEQDEV
        !            16:        I IOT["MT",IOPAR'["V" D ^%ZISC W !,$C(7),"Open this device with variable length records." G SEQDEV
        !            17:        S DIARIO=IO
        !            18:        ;
        !            19: RC     X DIARX I $E(DIARL,1,4)'["$IND"&($E(DIARL,1,4)'["$DAT") D ^%ZISC W !,$C(7),"Archive information is not in filegram format" G SEQDEV
        !            20:        I $E(DIARL,1,6)="$INDEX" S DIARIDX=1 D ^DIARR6 G RC3
        !            21:        U IO(0) W !!,"Sampling archived file...",!
        !            22: RC2    I $P(DIARL,U)="$DAT" S DIARFILE=$P(DIARL,U,2),DIARFN=+$P(DIARL,U,3)
        !            23:        X DIARX S DIARNAME=$P(DIARL,"=",2) X DIARX
        !            24:        F  X DIARX Q:(($P(DIARL,":")="END")&(+$P(DIARL,U,2)=DIARFN))  D RC1:$P(DIARL,":")="BEGIN" I ($P($P(DIARL,U),":")="IDENTIFIER")!($P($P(DIARL,U),":")="SPECIFIER") D ID
        !            25:        F  X DIARX Q:$P(DIARL,U)["$END DAT"  I +$P(DIARL,U,2)=".01" S DIAR01=$P(DIARL,U) S ^TMP("DIARHLP",$J,DIARRCT+1,.01)=DIAR01_" = "_$P(DIARL,"=",2) Q
        !            26:        I '$D(DIAR01) S DIARNM=1,^TMP("DIARHLP",$J,DIARRCT+1,.01)="NAME = "_DIARNAME
        !            27:        S DIARRCT=DIARRCT+1
        !            28:        F  X DIARX  Q:((DIARL["#$#")!(DIARRCT>5))  G RC2:((DIARRCT'>5)&($P(DIARL,U)["$DAT"))
        !            29:        ;
        !            30: RC3    I DIARNM,'$D(DIAR01) S DIAR01="NAME"
        !            31:        S DIARXXX=$$REWIND^%ZIS(IO,IOT,IOPAR)
        !            32:        ;
        !            33: FILE   U IO(0) W !,"You are reading archived information from the "_DIARFILE_" file."
        !            34:        K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to continue"
        !            35:        D ^DIR G EOJ:'Y!($D(DIRUT))
        !            36:        ;
        !            37:        D ^DIARR1 G EOJ:$D(DTOUT)!($D(DUOUT)&(DIARREQ'>0))!('$D(DIARR))!POP K DIRUT,DUOUT
        !            38:        D ^DIARR2
        !            39:        D ^DIARR3
        !            40:        D ^DIARR5
        !            41:        D EOJ
        !            42:        Q
        !            43:        ;
        !            44: ID     S DIARID(+$P(DIARL,U,2))=$P($P(DIARL,U),":",2)_U_+$P(DIARL,U,2)
        !            45:        S ^TMP("DIARHLP",$J,DIARRCT+1,$P($P(DIARL,U),":",2))=$P($P(DIARL,U),":",2)_" = "_$P(DIARL,"=",2)
        !            46:        Q
        !            47:        ;
        !            48: RC1    S DIARFN1=+$P(DIARL,U,2)
        !            49:        F  X DIARX Q:(($P(DIARL,":")="END")&(+$P(DIARL,U,2)=DIARFN1))
        !            50:        Q
        !            51:        ;
        !            52: EOJ    D ^%ZISC
        !            53:        K POP,DIARX,DIARFILE,DIARFN,DIARIO,DIARID,DIAR01,DIARZ,DIARREQ,DIARR,DIR,DIRUT,DTOUT,DUOUT,%MT,DIAROUT,DIARPDEV
        !            54:        K DIARL,DIARA,DIAREOF,DIARF2,DIARFGEN,DIARFGL,DIARMTCH,DIARNM,DIARY,DIARIDDN,DIARMTID,DIARMT01,DIARZID
        !            55:        K ^TMP("DIAR",$J),DIARRF,DIARZ1,DIARZ2,DIARRCT,DIARPG,DIARZL,DIARX1,DIARLINE,DIARIDS,DIARQUED,DIARFN1
        !            56:        K DIARHLP,DIARRHP,DIARZHP,DIARNAME,DIAROFLD,DIAROIDF,DIAROAT,DIAROFLD,DIAROIDF,DIAROLVL,DIAROSTK,DIAROVAL,DIAROXPL
        !            57:        K DIAROLNE,DIAROLUP,DIAROM,DIAROREQ,DIAROSUB,DIAROTAB,DIAROX,DIAROX1,DIAROZ,DIARZZ,DIARTAB,DIAROBPT,^TMP("DIARO",$J)
        !            58:        K DIAROBCK,DIAROBF,DIAROBFN,DIAROBF1,DIAROSF,DIAROSFN,DIAROXX,DIARCNT,DIARCTR,DIARFLD,DIARFLGT,DIARFNA,DIARFNO,DIARIDX
        !            59:        K DIARIXCT,DIARIXX,DIARPC,DIARREC,DIARVAL,DIARXX,DIARFND,DIARYY,DIARXXX,^TMP("DIARHLP",$J),DIAROX2,DIOF,DIOSL
        !            60:        Q