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

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1DIFGG4 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM SUBFILES ;6/10/93 1:41 PM
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4SUBFILE ; DO ONE SUBFILE
5 F DIFG(DILL,"FE")=0:0 S DIFG(DILL,"FE")=$O(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_")")) Q:DIFG(DILL,"FE")'=+DIFG(DILL,"FE") D SUBENTRY
6 Q
7 ;
8SUBENTRY ; DO ONE SUBFILE ENTRY
9 D DIS Q:'$T
10 D DR S DR(DIFG(DILL,"FILE"))=.01
11 S DIFG(DILL,"MUL")=1
12 D LOOKUP^DIFGGU
13 I $D(DIFGGUQ) K DIFGGUQ,DIFG(DILL,"MUL") Q
14 D DR,DRS
15 D RECURSEM
16 S V="^" D INCSET^DIFGGU
17 K DIFG(DILL,"MUL"),DA,DR
18 Q
19 ;
20DR ; CREATE DR-STRINGS
21 K DR S I=0
22 F %=DIFG(DILL,"FILE"):0 Q:'$D(^DD(%,0,"UP")) S X=^("UP"),Y=$O(^DD(X,"SB",%,0)),DR(X)=Y,DA(%)=DIFG(DILL-I,"FE"),%=X,I=I+1
23 S DA=DIFG(DILL-I,"FE"),DIC=DIFG(DILL-I,"FILE"),DR=DR(%) K DR(%)
24 Q
25 ;
26DRS ; PROCESS ALL DR STRINGS FOR FILE
27 S DR(DIFG(DILL,"FILE"))="",DITAB=DITAB+2
28 I $P(^DIPT(DIFGT,1,DIFGI,0),U,8) F DIFG2=.001:0 S %=DIFG(DILL,"FILE"),DIFG2=$O(^DD(%,DIFG2)) Q:DIFG2'>0 D DRA
29 F DIFG2=0:0 S DIFG2=$O(^DIPT(DIFGT,1,DIFGI,"F",DIFG2)) Q:DIFG2'=+DIFG2 I $D(^(DIFG2,0)) S DR(DIFG(DILL,"FILE"))=DR(DIFG(DILL,"FILE"))_^(0)_";" I $L(DR(DIFG(DILL,"FILE")))>200 D EN^DIFGG2 S DR(DIFG(DILL,"FILE"))=""
30 D EN^DIFGG2:DR(DIFG(DILL,"FILE"))]""
31 S DITAB=DITAB-2
32 Q
33 ;
34DRA ;Process all subfields
35 S %1=$P(^(0),U,0) I $S('%1:%1'["C",1:$P(^DD(+%1,.01,0),U,2)["W") S DR(%)=DR(%)_DIFG2_";" I $L(DR(%))>200 D EN^DIFGG2 S %=DIFG(DILL,"FILE"),DR(%)=""
36 Q
37 ;
38DIS ; SCREEN THIS ENTRY
39 F %=1:1:DILL S @("D"_(%-1))=DIFG(%,"FE")
40 I $D(DIFG(DIFG(DILL,"FILE"),"S"))#2 X DIFG(DIFG(DILL,"FILE"),"S") Q
41 I 1 Q
42 ;
43RECURSEM ; RECURSION FOR DEEPER SUBFILE SHIFTS
44 S DITAB=DITAB+2
45 D NEXTLVL^DIFGG
46 S DITAB=DITAB-2
47 Q
48 ;
49 ;
50DIFGG3 ; FILEGRAM NAVIGATION
51 ; SEE DIFGG3^DIFGGDOC
52 ;
53FILE ; PROCESS ONE FILE
54 F DIFG(DILL,"FE")=0:0 D FILE2 Q:DIFG(DILL,"FE")="" D ENTRY
55 K I,S,V,X
56 Q
57 ;
58FILE2 ;
59 S X=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),0))
60 Q:'X
61 S Y=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),X,0))
62 Q:'Y
63 I $P(^DD(X,Y,0),U,2)["V" S DIFG(DILL,"FSV")=""""_DIFG(DILL-1,"FE")_";"_$P(^DIC(DIFG(DILL-1,"FILE"),0,"GL"),U,2)_"""" I 1
64 E S DIFG(DILL,"FSV")=DIFG(DILL-1,"FE")
65 S DIFG(DILL,"FE")=$O(@(DIFG(DILL,"FGBL")_""""_DIFG(DILL,"XREF")_""","_DIFG(DILL,"FSV")_","_DIFG(DILL,"FE")_")"))
66 Q
67 ;
68ENTRY ; PROCESS ONE FILE ENTRY
69 S DIFG(DILL,"NAV")=1
70 D LOOKUP^DIFGGU
71 K DIFG(DILL,"NAV")
72 I $D(DIFGGUQ) K DIFGGUQ Q
73 S DITAB=DITAB+2
74 D ^DIFGG2
75 D RECURSEF
76 S DITAB=2*(DILL-1)
77 S V=":" D INCSET^DIFGGU
78 Q
79 ;
80RECURSEF ; RECURSION FOR DEEPER FILE SHIFTS
81 D NEXTLVL^DIFGG
82 Q
Note: See TracBrowser for help on using the repository browser.