Annotation of freem_fileman/DIARR2.m, revision 1.1

1.1     ! snw         1: DIARR2 ;SFISC/DCM-ARCHIVING(READ ARCHIVED FG) PROCESS REQUEST ;11/18/92  11:29 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        I $D(DIARIDX) D PROC^DIARR6 G C
        !             5:        ;
        !             6: FG     F DIARZ=1:1 X DIARX Q:(DIARL="#$#")  S ^TMP("DIARFG",$J,DIARZ)=DIARL D:DIARL="$END DAT" FG1
        !             7: C      S X=DIARIO X ^DD("FUNC",7,1) K:$D(DIARIO)#2&(DIARIO]"") IO(1,DIARIO)
        !             8:        D EOP
        !             9:        Q
        !            10:        ;
        !            11: FG1    F DIARZ=1:1 S DIARFGL=$G(^TMP("DIARFG",$J,DIARZ)) Q:((DIARFGL="$END DAT")!(DIARFGEN))  D FG2
        !            12:        D IDS
        !            13:        D MATCH
        !            14:        D EOP
        !            15:        Q
        !            16:        ;
        !            17: FG2    Q:$P(DIARFGL,U)="$DAT"
        !            18:        I DIARNM,$P(DIARFGL,U)=DIARFILE S DIARA(".01")=$P(DIARFGL,"=",2) Q
        !            19:        I $P(DIARFGL,":")="BEGIN" D FG3 Q
        !            20:        I $P(DIARFGL,":")="IDENTIFIER" S DIARA("ID",+$P(DIARFGL,U,2))=$P(DIARFGL,"=",2) Q
        !            21:        I $P(DIARFGL,":")="SPECIFIER" S DIARA("ID",+$P(DIARFGL,U,2))=$P(DIARFGL,"=",2) Q
        !            22:        I +$P(DIARFGL,U,2)=".01" S DIARA(".01")=$P(DIARFGL,"=",2) S DIARFGEN=1 Q
        !            23:        Q
        !            24:        ;
        !            25: FG3    Q:+$P(DIARFGL,U,2)=DIARFN
        !            26:        S DIARF2=+$P(DIARFGL,U,2),DIARZ=DIARZ+1
        !            27:        F DIARZ=DIARZ:1 S DIARFGL=$G(^TMP("DIARFG",$J,DIARZ)) Q:(($P(DIARFGL,":")="END")&(+$P(DIARFGL,U,2)=DIARF2))
        !            28:        Q
        !            29:        ;
        !            30: IDS    F DIARIDS=0:0 S DIARIDS=$O(DIARID(DIARIDS)) Q:DIARIDS'>0  I '$D(DIARA("ID",DIARIDS)) S DIARA("ID",DIARIDS)=""
        !            31:        Q
        !            32:        ;
        !            33: MS     S DIARMTID="",DIARMT01=0,DIARMTCH=0,DIARIDDN=0,DIARRF(DIARY)=$S($D(DIARRF(DIARY)):DIARRF(DIARY),1:0) Q
        !            34:        ;
        !            35: MATCH  F DIARY=0:0 S DIARY=$O(DIARR(DIARY)) Q:DIARY'>0  D MS D:$D(DIARR(DIARY,".01")) MATCH01 D:$D(DIARR(DIARY,"ID")) MATCHID:'DIARIDDN D:DIARMTCH FOUND
        !            36:        Q
        !            37:        ;
        !            38: MATCH01        Q:DIARR(DIARY,".01")=""  Q:DIARA(".01")=""
        !            39:        I $P(DIARA(".01"),DIARR(DIARY,.01))="" S DIARMT01=1
        !            40:        I $D(DIARR(DIARY,"ID")) D MATCHID I 'DIARMTID Q
        !            41:        I DIARMT01 S DIARMTCH=1
        !            42:        Q
        !            43:        ;
        !            44: MATCHID        F DIARZID=0:0 S DIARZID=$O(DIARR(DIARY,"ID",DIARZID))  Q:DIARZID'>0  D MATCHID1 Q:DIARMTID=0
        !            45:        I DIARMTID,'$D(DIARR(DIARY,".01")) S DIARMTCH=1
        !            46:        S DIARIDDN=1
        !            47:        Q
        !            48:        ;
        !            49: MATCHID1       Q:DIARR(DIARY,"ID",DIARZID)=""  Q:DIARA("ID",DIARZID)=""
        !            50:        I $P(DIARA("ID",DIARZID),DIARR(DIARY,"ID",DIARZID))="" S DIARMTID=1 Q
        !            51:        S DIARMTID=0
        !            52:        Q
        !            53:        ;
        !            54: FOUND  S DIARFND=1
        !            55:        I $D(DIARIDX) S DIARIXX(DIARIXCT)=DIARIXX(DIARIXCT)_DIARY_"," Q
        !            56:        S %X="^TMP(""DIARFG"",$J,",%Y="^TMP(""DIAR"",$J,DIARY,DIARRF(DIARY)+1," D %XY^%RCR
        !            57:        S DIARRF(DIARY)=DIARRF(DIARY)+1
        !            58:        Q
        !            59:        ;
        !            60: EOP    S DIARZ=0,DIARFGEN=0
        !            61:        K ^TMP("DIARFG",$J),DIARA
        !            62:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>