Return to DIFGGU.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIFGGU	;SFISC/XAK,EDE(OHPRD)-FILEGRAM FUNCTIONS  ; [ 11/10/92  10:38 AM ]
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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