Return to DIARR2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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