Return to DIFGGSB1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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