File:  [Coherent Logic Development] / freem_fileman / USER / DIFGGSB2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIFGGSB2	;SFISC/DG,EDE(OHPRD)- ;6/19/92  9:28 AM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: SPSPEC	; UNIQUE SPECIFIER
    5: 	F DIFGSB(DILL,"SPSPEC")=0:0 S DIFGSB(DILL,"SPSPEC")=$O(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"SPSPEC"))) Q:'DIFGSB(DILL,"SPSPEC")  I +^(DIFGSB(DILL,"SPSPEC")) Q:$P(^(DIFGSB(DILL,"SPSPEC")),U,2)'=""
    6: 	Q:'DIFGSB(DILL,"SPSPEC")
    7: 	I $P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"SPSPEC"),0),U,2)["P" S DIFGSB(DILL,"SPSPEC")=0 Q
    8: 	S $P(DIFGSB(DILL,"SPSPEC"),U,2)=$P(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"SPSPEC")),U,2)
    9: 	S DIFGSB(DILL,"FLD")=+DIFGSB(DILL,"SPSPEC")
   10: 	I '$D(DIFG(DILL,"MUL")) S DR=+DIFGSB(DILL,"SPSPEC")
   11: 	E  S DR(DIFG(DILL,"FILE"))=+DIFGSB(DILL,"SPSPEC")
   12: 	S DIFGSB(DILL,"SBT")="KEY:"
   13: 	D FIELDS^DIFGGSB1
   14: 	Q
   15: 	;
   16: PTRCHK	; CHECK FOR POINTER FIELD
   17: 	Q:$P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,2)'["P"
   18: 	S DITAB=DITAB+2
   19: 	S DILL=DILL+1
   20: 	D POINTER
   21: 	S DITAB=DITAB-2
   22: 	K DIFG(DILL)
   23: 	S DILL=DILL-1
   24: 	Q
   25: 	;
   26: POINTER	; POINTER FIELDS
   27: 	S DIFG(DILL,"FILE")=+$P($P(^DD(DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD"),0),U,2),"P",2),X=$P(^(0),U,4) S:$P(X,";")'=+X X=""""_$P(X,";")_""";"_$P(X,";",2)
   28: 	I $D(DIFGGU(DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"),DIFGSB(DILL-1,"FLD"),"P")) S DIFG(DILL,"FE")=DIFGGU(DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"),DIFGSB(DILL-1,"FLD"),"P")
   29: 	E  S DIFG(DILL,"FE")=$P(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_$P(X,";",1)_")"),U,$P(X,";",2))
   30: 	I '$D(^DIC(DIFG(DILL,"FILE"),0)) D KILLLL^DIFGGU Q
   31: 	S DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL"),DIFG(DILL,"FNAME")=$P(^DIC(DIFG(DILL,"FILE"),0),U,1)
   32: 	I '$D(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)")) D KILLLL^DIFGGU Q
   33: 	I $D(Y),Y'="" S Z=Y,Y=""
   34: 	I $D(DIFGENV("LAYGO",DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD")))!($P(^DD(DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD"),0),U,2)'["'") S DIFG(DILL,"NOKEY")=""
   35: 	D START^DIFGGSB ; RECURSE
   36: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>