source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIARR2.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1DIARR2 ;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 ;
6FG F DIARZ=1:1 X DIARX Q:(DIARL="#$#") S ^TMP("DIARFG",$J,DIARZ)=DIARL D:DIARL="$END DAT" FG1
7C S X=DIARIO X ^DD("FUNC",7,1) K:$D(DIARIO)#2&(DIARIO]"") IO(1,DIARIO)
8 D EOP
9 Q
10 ;
11FG1 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 ;
17FG2 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 ;
25FG3 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 ;
30IDS F DIARIDS=0:0 S DIARIDS=$O(DIARID(DIARIDS)) Q:DIARIDS'>0 I '$D(DIARA("ID",DIARIDS)) S DIARA("ID",DIARIDS)=""
31 Q
32 ;
33MS S DIARMTID="",DIARMT01=0,DIARMTCH=0,DIARIDDN=0,DIARRF(DIARY)=$S($D(DIARRF(DIARY)):DIARRF(DIARY),1:0) Q
34 ;
35MATCH 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 ;
38MATCH01 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 ;
44MATCHID 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 ;
49MATCHID1 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 ;
54FOUND 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 ;
60EOP S DIARZ=0,DIARFGEN=0
61 K ^TMP("DIARFG",$J),DIARA
62 Q
Note: See TracBrowser for help on using the repository browser.