| [613] | 1 | DIARR2 ;SFISC/DCM-ARCHIVING(READ ARCHIVED FG) PROCESS REQUEST ;11/18/92 11:29 AM
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
