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

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1DIFGGU ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FUNCTIONS ; [ 11/10/92 10:38 AM ]
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; Required variables:
5 ;
6 ; DILC
7 ; DITAB
8 ; DIFG("PARM")
9 ; DIFG("FGR")
10 ; DILL
11 ; DIFG(DILL,"FILE")
12 ; DIFG(DILL,"FNAME")
13 ; DIFG(DILL,"FE")
14 ; DIFG(DILL,"FGBL")
15 ; DIFG(DILL,"FUNC")
16 ;
17 Q ; INVALID ENTRY POINT
18 ;
19LOOKUP ; EXTERNAL ENTRY POINT
20 ; LOOKUP ENTRY IN FILE/SUBFILE
21 D SETX
22 Q:$D(DIFGGUQ)
23 S Z=""
24 I '$D(^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) D SETLINK
25 I $D(^DD(DIFG(DILL,"FILE"),0,"UP")) S A=^("UP"),B=$O(^DD(A,"SB",DIFG(DILL,"FILE"),0)),C=$P(^DD(A,B,0),U,1),V=C_U_$S(DIFG("PARM")["N":B,1:"") K A,B,C
26 E S V=DIFG(DILL,"FNAME")_U_$S(DIFG("PARM")["N":DIFG(DILL,"FILE"),1:"")
27 S V=V_$S($D(DIFG(DILL,"NAV")):":",1:"")_U_DIFG(DILL,"FUNC")_"="_X
28 I $D(DIFG(DILL,"NAV")),DIFG(DILL,"NAV")=1,$G(DIFG(DILL,"XREF"))?1A.E S V=V_U_DIFG(DILL,"XREF")_"=@"_^UTILITY("DIFGLINK",$J,DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"))
29 D INCSET
30 D:Z'="" SPBLK
31 K S,V,X,Z
32 Q
33 ;
34SETLINK ;
35 S ^UTILITY("DIFGLINK",$J)=$S($D(^UTILITY("DIFGLINK",$J))#2:^UTILITY("DIFGLINK",$J)+1,1:1),^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))=^UTILITY("DIFGLINK",$J)
36 S Z="@"_^UTILITY("DIFGLINK",$J)
37 Q
38 ;
39SETX ; SET X TO @LINK OR LOOKUP VALUE
40 S X=""
41 D SETX2
42 Q:$D(DIFGGUQ)
43 Q:X'=""
44 I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)) S X=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01) Q
45 K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
46 I '$D(DIFG(DILL,"MUL")) S DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE"),DR=".01"
47 S DIQ(0)="N" D EN^DIQ1 K DIQ
48 S X=^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01)
49 K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
50 I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
51 Q
52 ;
53SETX2 ; IF POINTER AND ALREADY LOOKED UP SET @LINK
54 K DIFGGUQ
55 I $D(^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) S X="@"_^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))_"E"
56 Q:$P(^DD(DIFG(DILL,"FILE"),.01,0),U,2)'["P"
57 S X=+$P($P(^DD(DIFG(DILL,"FILE"),.01,0),U,2),"P",2)
58 I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P")) S Y=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),.01,"P") I 1
59 E S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)"),U,1)
60 NEW G
61 S G="^"_$P(^DD(DIFG(DILL,"FILE"),.01,0),U,3)
62 I '$D(@(G_Y_",0)")) S DIFGGUQ=1 Q
63 S X=$S($D(^UTILITY("DIFGLINK",$J,X,Y)):"@"_^UTILITY("DIFGLINK",$J,X,Y),1:"")
64 K Y
65 Q
66 ;
67SPBLK ; SPECIAL BLOCK
68 S DITAB=DITAB+2
69 D ^DIFGGSB
70 S DITAB=DITAB-2
71 Q
72 ;
73INCSET ; EXTERNAL ENTRY POINT
74 ; INCREMENT LINE COUNT AND SET LINE
75 S DILC=DILC+1
76 S S=""
77 I '$D(DIFG("WP")) S:DITAB $P(S," ",DITAB)=" "
78 S @(DIFG("FGR")_DILC_",0)")=S_V
79 Q
80 ;
81KILLLL ; EXTERNAL ENTRY POINT
82 ; KILL LAST LINE, DECREMENT LINE COUNT, KILL LAST LINK, DECREMENT LINK COUNT
83 D KILLDEC,DELLINK
84 Q
85 ;
86KILLDEC ; EXTERNAL ENTRY POINT
87 ; KILL LAST LINE AND DECREMENT LINE COUNT
88 K @(DIFG("FGR")_DILC_",0)")
89 S DILC=DILC-1
90 Q
91 ;
92DELLINK ; EXTERNAL ENTRY POINT
93 ; DELETE LAST @LINK AND DECREMENT LINK COUNTER
94 K ^UTILITY("DIFGLINK",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"))
95 S ^UTILITY("DIFGLINK",$J)=^UTILITY("DIFGLINK",$J)-1
96 Q
Note: See TracBrowser for help on using the repository browser.