Return to DIARR6.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIARR6.m, revision 1.1

1.1     ! snw         1: DIARR6 ;SFISC/DCM-PROCESS ARCHIVED FILE WITH INDEX ;11/18/92  11:49 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S DIARFILE=$P(DIARL,U,3),DIARFN=+$P(DIARL,U,2)
        !             5:        S DIARREC=$P(DIARL,U,4,99)
        !             6:        F DIARXX=1:1 S DIARFLD=$P(DIARREC,U,DIARXX) Q:DIARFLD=""  S DIARFNO=$P(DIARFLD,":"),DIARFNA=$P(DIARFLD,":",2) D
        !             7:        . I +DIARFNO=.01 S DIAR01=DIARFNA
        !             8:        . S DIARPC(DIARXX)=DIARFNO_U_DIARFNA
        !             9:        . S:+DIARFNO'=.01 DIARID(DIARFNO)=DIARFNA_U_DIARFNO
        !            10:        . S DIARCNT=DIARXX
        !            11:        . Q
        !            12:        S DIARCTR=0,DIARFLGT=0
        !            13:        F  X DIARX Q:DIARL["$DAT"  S DIARCTR=DIARCTR+1 F DIARXX=1:1:DIARCNT S DIARFLD=$P(DIARL,U,DIARXX) S DIARFNA=$P(DIARPC(DIARXX),U,2),DIARFNO=+DIARPC(DIARXX),^TMP("DIARHLP",$J,DIARCTR,DIARFNO)=DIARFNA_" = "_DIARFLD D FLGTH
        !            14:        Q
        !            15:        ;
        !            16: FLGTH  S $P(DIARPC(DIARXX),U,3)=$S($L(DIARFLD)>+$P(DIARPC(DIARXX),U,3):$L(DIARFLD),1:+$P(DIARPC(DIARXX),U,3))
        !            17:        Q
        !            18:        ;
        !            19: PROC   S DIARIXCT=0 K DIARRF
        !            20: PROC1  F  X DIARX Q:DIARL["$DAT"  G PROC1:DIARL["$INDEX" D PROC2 D MATCH^DIARR2 K:'$G(DIARIXX(DIARIXCT)) DIARIXX(DIARIXCT) G PROC1
        !            21:        Q:'$D(DIARIXX)
        !            22:        S (DIARIXCT,DIARXX)=1 D:$G(DIARIXX(DIARIXCT)) FOUND
        !            23:        F  S DIARXX=$O(DIARIXX(DIARXX)) Q:DIARXX'>0  D PROC1A
        !            24:        Q
        !            25:        ;
        !            26: PROC1A F  X DIARX Q:DIARL["#$#"  I DIARL["$DAT" S DIARIXCT=DIARIXCT+1 I DIARIXCT=DIARXX D FOUND Q
        !            27:        Q
        !            28:        ;
        !            29: PROC2  K DIARA S DIARIXCT=DIARIXCT+1,DIARIXX(DIARIXCT)=""
        !            30:        F DIARXX=1:1:DIARCNT S DIARVAL=$P(DIARL,U,DIARXX) D PROC2A
        !            31:        Q
        !            32:        ;
        !            33: PROC2A I +$P(DIARPC(DIARXX),U)=.01 S DIARA(.01)=DIARVAL Q
        !            34:        S DIARA("ID",+$P(DIARPC(DIARXX),U))=DIARVAL
        !            35:        Q
        !            36:        ;
        !            37: FOUND  K ^TMP("DIARFG",$J) S DIARZ=1 D SET
        !            38:        F DIARZ=DIARZ+1:1 X DIARX D SET I DIARL["$END DAT" Q
        !            39:        F DIARZ=1:1 S DIARY=$P(DIARIXX(DIARIXCT),",",DIARZ) Q:DIARY=""  S DIARRF(DIARY)=$S($D(DIARRF(DIARY)):DIARRF(DIARY)+1,1:0) D SETFG
        !            40:        Q
        !            41:        ;
        !            42: SET    S ^TMP("DIARFG",$J,DIARZ)=DIARL
        !            43:        Q
        !            44:        ;
        !            45: SETFG  S %X="^TMP(""DIARFG"",$J,",%Y="^TMP(""DIAR"",$J,DIARY,DIARRF(DIARY)," D %XY^%RCR
        !            46:        Q