Return to DIARR3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

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

1.1     ! snw         1: DIARR3 ;SFISC/DCM-ARCHIVING FUNCTION, FIGURE OUT FG ;3/15/93  7:55 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        Q:'DIARFND  U IO(0) W !,"Formatting found records..."
        !             5:        S (DIARTAB,DIAROREQ,DIAROM,DIAROZ,DIARZZ,DIAROIDF,DIAROFLD,DIAROLVL,DIAROBPT,DIAROBFN)=0,DIAROFLD(DIAROLVL)=0 K ^TMP("DIARO",$J)
        !             6:        F  S DIAROREQ=$O(^TMP("DIAR",$J,DIAROREQ)) Q:DIAROREQ'>0  F  S DIAROM=$O(^TMP("DIAR",$J,DIAROREQ,DIAROM)) Q:DIAROM'>0  D CLEANUP^DIARR4 F  S DIAROZ=$O(^TMP("DIAR",$J,DIAROREQ,DIAROM,DIAROZ)) Q:DIAROZ'>0  S DIAROX=^(DIAROZ) D EN
        !             7:        Q
        !             8: EN     Q:DIAROX["$END DAT"!(DIAROX="")
        !             9:        S DIAROX1=$P(DIAROX,":")
        !            10:        I $P(DIAROX,U)="$DAT" S DIAROSF=$P(DIAROX,U,2),DIAROSFN=+$P(DIAROX,U,3),DIAROLNE="ARCHIVE FILE: "_DIAROSF_" (#"_DIAROSFN_")" D SET D SV Q
        !            11:        Q:DIAROX["$END DAT"
        !            12: EN1    I DIAROX1="BEGIN" D BEGIN D SV Q
        !            13:        I DIAROX1="END" D END D SV Q
        !            14:        I DIAROX1="IDENTIFIER"!(DIAROX1="SPECIFIER")!(DIAROX1="KEY") D ID D SV Q
        !            15:        I $L(DIAROX,U)=3,"AMLD"[$P($P(DIAROX,U,3),"=") G:$P(DIAROX,"=",2)?1"@".N1"E" BE^DIARR4 D F1 I DIAROSFN=+$P(DIAROX,U,2) D SV Q
        !            16:        I DIAROX="^"!(DIAROX=":") D POP^DIARR4 D SV Q
        !            17:        I $E(DIAROX1)="""" S DIAROLNE=$E(DIAROX1,2,$L(DIAROX1)-1) D SET Q
        !            18:        D FLDS
        !            19: SV     S DIAROXPL=DIAROX
        !            20:        Q
        !            21: BEGIN  S DIAROBF=$P($P(DIAROX,U),":",2),DIAROBFN=+$P(DIAROX,U,2),DIARTAB=DIARTAB+2,DIAROLVL=DIAROLVL+1,DIAROSTK(DIAROLVL)=DIAROBF_U_DIAROBFN_U_DIARTAB,DIAROIDF(DIAROLVL)=0,DIAROFLD(DIAROLVL)=0
        !            22:        S DIAROSUB="@"_$P(DIAROX,"@",2),DIAROAT(DIAROSUB)=$S(DIAROXPL["@":"@"_$P(DIAROXPL,"@",2),1:$P(DIAROXPL,"=",2)) I DIAROBPT D SUB Q
        !            23:        I DIAROZ=3 G BEGLN1
        !            24:        I $P(DIAROXPL,U,2)[":" S DIAROLNE="FILE: " D SUB G BEGLN
        !            25:        I $P(DIAROXPL,":")="BEGIN" S DIAROLNE=".01 POINTER TO FILE: " G BEGLN
        !            26:        I $L(DIAROXPL,U)=3,"AMLD"[$P($P(DIAROXPL,U,3),"=") S DIAROLNE="SUBFILE: " D SUB G BEGLN
        !            27:        I $L(DIAROXPL,U)=2 S DIAROLNE="POINTER TO FILE: "
        !            28: BEGLN  S DIAROLNE=DIAROLNE_DIAROBF_" (#"_DIAROBFN_")"
        !            29:        D SET
        !            30: BEGLN1 I $D(DIAROLUP(DIAROBF)) S DIARTAB=$P(DIAROSTK(DIAROLVL),U,3),DIAROLNE=$P(DIAROLUP(DIAROBF),U) D SET K DIAROLUP(DIAROBF)
        !            31:        Q
        !            32: SUB    S DIAROSUB(DIAROBFN)=1_U_DIARTAB
        !            33:        Q
        !            34: END    S (DIAROIDF(DIAROLVL),DIAROFLD(DIAROLVL))=0,DIAROBF=$P(DIAROSTK(DIAROLVL),U),DIAROBFN=$P(DIAROSTK(DIAROLVL),U,2)
        !            35:        I $D(DIAROSUB(DIAROBFN)) S DIARTAB=DIARTAB-2 Q
        !            36:        S:DIAROLVL'=1 DIAROLVL=DIAROLVL-1
        !            37:        Q
        !            38: ID     I DIAROIDF(DIAROLVL)=0 S DIAROLNE="IDENTIFIERS: ",DIARTAB=+$P(DIAROSTK(DIAROLVL),U,3)+2 D SET S DIAROIDF(DIAROLVL)=1
        !            39:        S DIAROLNE=$P($P(DIAROX,U),":",2)_" (#"_+$P(DIAROX,U,2)_") = "_$P(DIAROX,"=",2),DIARTAB=+$P(DIAROSTK(DIAROLVL),U,3)+4 D SET
        !            40:        Q
        !            41: FLDS   S DIAROBCK=0
        !            42:        I DIAROLVL=1,DIAROFLD(DIAROLVL)=0 S DIAROLNE="FIELDS: ",DIARTAB=+$P(DIAROSTK(DIAROLVL),U,3)+2 D SET S DIAROFLD(DIAROLVL)=1
        !            43:        S (DIAROVAL,DIAROLUP)=$P(DIAROX,"=",2),DIARTAB=$P(DIAROSTK(DIAROLVL),U,3)+4
        !            44:        I $L(DIAROX,U)=3 S DIAROBF1=$P(DIAROX,U,2) I $E(DIAROBF1,$L(DIAROBF1))=":" D BKPTR^DIARR4 Q
        !            45:        I +$P(DIAROX,U,2),DIAROVAL["" S DIAROLNE="FIELD NAME: "_$P(DIAROX,U)_" (#"_+$P(DIAROX,U,2)_") = " D LKUP^DIARR4:$E(DIAROVAL)="@" G:DIAROBCK FLDS
        !            46:        I $D(DIAROSUB)=11 S DIARTAB=$P(DIAROSTK(DIAROLVL),U,3)+2
        !            47:        S DIAROLNE=DIAROLNE_DIAROVAL D SET Q
        !            48:        S:$D(DIAROXX) DIAROX=DIAROXX K DIAROXX
        !            49:        Q
        !            50: SET    S DIAROTAB="" S:DIARTAB $P(DIAROTAB," ",DIARTAB)=" "
        !            51:        S DIARZZ=DIARZZ+1,DIAROLNE=DIAROTAB_DIAROLNE
        !            52:        S ^TMP("DIARO",$J,DIAROREQ,DIAROM,DIARZZ)=DIAROLNE
        !            53:        Q
        !            54: F1     S DIAROLUP($P(DIAROX,U))="LOOKUP VALUE (#.01): "_$P(DIAROX,"=",2)
        !            55:        Q