1 | DIFGGU ;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 | ;
|
---|
19 | LOOKUP ; 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 | ;
|
---|
34 | SETLINK ;
|
---|
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 | ;
|
---|
39 | SETX ; 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 | ;
|
---|
53 | SETX2 ; 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 | ;
|
---|
67 | SPBLK ; SPECIAL BLOCK
|
---|
68 | S DITAB=DITAB+2
|
---|
69 | D ^DIFGGSB
|
---|
70 | S DITAB=DITAB-2
|
---|
71 | Q
|
---|
72 | ;
|
---|
73 | INCSET ; 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 | ;
|
---|
81 | KILLLL ; EXTERNAL ENTRY POINT
|
---|
82 | ; KILL LAST LINE, DECREMENT LINE COUNT, KILL LAST LINK, DECREMENT LINK COUNT
|
---|
83 | D KILLDEC,DELLINK
|
---|
84 | Q
|
---|
85 | ;
|
---|
86 | KILLDEC ; 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 | ;
|
---|
92 | DELLINK ; 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
|
---|