Annotation of freem_fileman/DIFGGSB1.m, revision 1.1.1.1
1.1 snw 1: DIFGGSB1 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM SPECIAL BLOCK PART 2 ;2/3/93 12:46 PM
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: BODY S DIFGSB(DILL,"SPSPEC")=0
5: I $D(DIFG(DILL,"FUNC")),"AL"[DIFG(DILL,"FUNC") I 1
6: E I $D(DIFG(DILL,"NOKEY"))
7: E D SPSPEC^DIFGGSB2
8: Q:DIFGSB(DILL,"SPSPEC")
9: D P01
10: D SPEC
11: D IDENT
12: Q
13: ;
14: P01 ; .01 FIELD WHEN IT IS A POINTER
15: Q:$P(^DD(DIFG(DILL,"FILE"),.01,0),U,2)'["P"
16: S DIFGSB(DILL,"FLD")=.01
17: D SETXY
18: Q:Y=""
19: D PTRCHK^DIFGGSB2
20: Q
21: ;
22: SPEC ; SPECIFIERS
23: S DIFGSB(DILL,"SBT")="SPECIFIER:",%=""
24: F DIFGSB(DILL,"FLD")=0:0 D SPEC2 Q:DIFGSB(DILL,"FLD")'=+DIFGSB(DILL,"FLD") S %=%_$S(%="":DIFGSB(DILL,"FLD"),1:";"_DIFGSB(DILL,"FLD"))
25: I '$D(DIFG(DILL,"MUL")) S DR=% D:%'="" FIELDS I 1
26: E S DR(DIFG(DILL,"FILE"))=% D:%'="" FIELDS
27: K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
28: I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
29: K % Q
30: ;
31: SPEC2 S DIFGSB(DILL,"FLD")=$O(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"FLD")))
32: Q
33: ;
34: IDENT ; IDENTIFIERS
35: S DIFGSB(DILL,"SBT")="IDENTIFIER:",%=""
36: F DIFGSB(DILL,"FLD")=0:0 D IDENT2 Q:DIFGSB(DILL,"FLD")'=+DIFGSB(DILL,"FLD") D:'$D(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"FLD"))) IDENT3
37: I '$D(DIFG(DILL,"MUL")) S DR=% D:%'="" FIELDS I 1
38: E S DR(DIFG(DILL,"FILE"))=% D:%'="" FIELDS
39: K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
40: I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
41: K %
42: Q
43: ;
44: IDENT2 S DIFGSB(DILL,"FLD")=$O(^DD(DIFG(DILL,"FILE"),0,"ID",DIFGSB(DILL,"FLD")))
45: Q
46: ;
47: IDENT3 S %=%_$S(%="":DIFGSB(DILL,"FLD"),1:";"_DIFGSB(DILL,"FLD"))
48: Q
49: ;
50: FIELDS I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) D DRFIX
51: I '$D(DIFG(DILL,"MUL")) Q:DR=""
52: E Q:DR(DIFG(DILL,"FILE"))=""
53: K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
54: S:'$D(DIFG(DILL,"MUL")) DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE")
55: S DIQ(0)="N" D EN^DIQ1 K DIQ
56: F DIFGSB(DILL,"FLD")=0:0 D FIELDS2 Q:DIFGSB(DILL,"FLD")'=+DIFGSB(DILL,"FLD") S X=^(DIFGSB(DILL,"FLD")) D FIELDS3
57: Q
58: ;
59: DRFIX ; ADJUST DR FOR MODIFIED/DELETED VALUES
60: NEW T
61: I '$D(DIFG(DILL,"MUL")) S T=DR
62: E S T=DR(DIFG(DILL,"FILE"))
63: F %=1:1 S X=$P(T,";",%) Q:X="" S %(X)="" I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),X)) K %(X) S DIFGSB(DILL,"FLD")=X,X=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),X) D DRFIX2
64: S (T,X)=""
65: F %=0:0 S X=$O(%(X)) Q:X="" S T=T_$S(T="":"",1:";")_X
66: I '$D(DIFG(DILL,"MUL")) S DR=T
67: E S DR(DIFG(DILL,"FILE"))=T
68: Q
69: ;
70: DRFIX2 NEW %,DR,T
71: D FIELDS3
72: Q
73: ;
74: FIELDS2 S DIFGSB(DILL,"FLD")=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFGSB(DILL,"FLD")))
75: Q
76: ;
77: FIELDS3 Q:X=""
78: D SETXY
79: K F,N,P,W
80: S V=DIFGSB(DILL,"SBT")_$P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,1)_U_$S(DIFG("PARM")["N":DIFGSB(DILL,"FLD"),1:"")
81: S:DIFGSB(DILL,"SBT")["KEY" V=V_U_$P(DIFGSB(DILL,"SPSPEC"),U,2)
82: S V=V_"="_X
83: D INCSET^DIFGGU
84: D:Y'="" PTRCHK^DIFGGSB2
85: K X,Y
86: Q
87: SETXY ; If previously looked up pointer set @LINK
88: S Y=""
89: Q:$P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,2)'["P"
90: S F=+$P($P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,2),"P",2),W=$P(^(0),U,4),N=$P(W,";",1),P=$P(W,";",2)
91: I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFGSB(DILL,"FLD"),"P")) S Y=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFGSB(DILL,"FLD"),"P") I 1
92: E S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",N)"),U,P)
93: I $D(^UTILITY("DIFGLINK",$J,F,Y)) S X="@"_^UTILITY("DIFGLINK",$J,F,Y),Y="" Q
94: S ^UTILITY("DIFGLINK",$J)=$S($D(^UTILITY("DIFGLINK",$J))#2:^UTILITY("DIFGLINK",$J)+1,1:1)
95: S ^UTILITY("DIFGLINK",$J,F,Y)=^UTILITY("DIFGLINK",$J)
96: S Y="@"_^UTILITY("DIFGLINK",$J)
97: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIFGGSB1.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman