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>