Return to DIFGG4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIFGG4	;SFISC/XAK,EDE(OHPRD)-FILEGRAM SUBFILES ;6/10/93  1:41 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: SUBFILE	; DO ONE SUBFILE
    5: 	F DIFG(DILL,"FE")=0:0 S DIFG(DILL,"FE")=$O(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_")")) Q:DIFG(DILL,"FE")'=+DIFG(DILL,"FE")  D SUBENTRY
    6: 	Q
    7: 	;
    8: SUBENTRY	; DO ONE SUBFILE ENTRY
    9: 	D DIS Q:'$T
   10: 	D DR S DR(DIFG(DILL,"FILE"))=.01
   11: 	S DIFG(DILL,"MUL")=1
   12: 	D LOOKUP^DIFGGU
   13: 	I $D(DIFGGUQ) K DIFGGUQ,DIFG(DILL,"MUL") Q
   14: 	D DR,DRS
   15: 	D RECURSEM
   16: 	S V="^" D INCSET^DIFGGU
   17: 	K DIFG(DILL,"MUL"),DA,DR
   18: 	Q
   19: 	;
   20: DR	; CREATE DR-STRINGS
   21: 	K DR S I=0
   22: 	F %=DIFG(DILL,"FILE"):0 Q:'$D(^DD(%,0,"UP"))  S X=^("UP"),Y=$O(^DD(X,"SB",%,0)),DR(X)=Y,DA(%)=DIFG(DILL-I,"FE"),%=X,I=I+1
   23: 	S DA=DIFG(DILL-I,"FE"),DIC=DIFG(DILL-I,"FILE"),DR=DR(%) K DR(%)
   24: 	Q
   25: 	;
   26: DRS	; PROCESS ALL DR STRINGS FOR FILE
   27: 	S DR(DIFG(DILL,"FILE"))="",DITAB=DITAB+2
   28: 	I $P(^DIPT(DIFGT,1,DIFGI,0),U,8) F DIFG2=.001:0 S %=DIFG(DILL,"FILE"),DIFG2=$O(^DD(%,DIFG2)) Q:DIFG2'>0  D DRA
   29: 	F DIFG2=0:0 S DIFG2=$O(^DIPT(DIFGT,1,DIFGI,"F",DIFG2)) Q:DIFG2'=+DIFG2  I $D(^(DIFG2,0)) S DR(DIFG(DILL,"FILE"))=DR(DIFG(DILL,"FILE"))_^(0)_";" I $L(DR(DIFG(DILL,"FILE")))>200 D EN^DIFGG2 S DR(DIFG(DILL,"FILE"))=""
   30: 	D EN^DIFGG2:DR(DIFG(DILL,"FILE"))]""
   31: 	S DITAB=DITAB-2
   32: 	Q
   33: 	;
   34: DRA	;Process all subfields
   35: 	S %1=$P(^(0),U,0) I $S('%1:%1'["C",1:$P(^DD(+%1,.01,0),U,2)["W") S DR(%)=DR(%)_DIFG2_";" I $L(DR(%))>200 D EN^DIFGG2 S %=DIFG(DILL,"FILE"),DR(%)=""
   36: 	Q
   37: 	;
   38: DIS	; SCREEN THIS ENTRY
   39: 	F %=1:1:DILL S @("D"_(%-1))=DIFG(%,"FE")
   40: 	I $D(DIFG(DIFG(DILL,"FILE"),"S"))#2 X DIFG(DIFG(DILL,"FILE"),"S") Q
   41: 	I 1 Q
   42: 	;
   43: RECURSEM	; RECURSION FOR DEEPER SUBFILE SHIFTS
   44: 	S DITAB=DITAB+2
   45: 	D NEXTLVL^DIFGG
   46: 	S DITAB=DITAB-2
   47: 	Q
   48: 	;
   49: 	;
   50: DIFGG3	; FILEGRAM NAVIGATION
   51: 	; SEE DIFGG3^DIFGGDOC
   52: 	;
   53: FILE	; PROCESS ONE FILE
   54: 	F DIFG(DILL,"FE")=0:0 D FILE2 Q:DIFG(DILL,"FE")=""  D ENTRY
   55: 	K I,S,V,X
   56: 	Q
   57: 	;
   58: FILE2	;
   59: 	S X=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),0))
   60: 	Q:'X
   61: 	S Y=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),X,0))
   62: 	Q:'Y
   63: 	I $P(^DD(X,Y,0),U,2)["V" S DIFG(DILL,"FSV")=""""_DIFG(DILL-1,"FE")_";"_$P(^DIC(DIFG(DILL-1,"FILE"),0,"GL"),U,2)_"""" I 1
   64: 	E  S DIFG(DILL,"FSV")=DIFG(DILL-1,"FE")
   65: 	S DIFG(DILL,"FE")=$O(@(DIFG(DILL,"FGBL")_""""_DIFG(DILL,"XREF")_""","_DIFG(DILL,"FSV")_","_DIFG(DILL,"FE")_")"))
   66: 	Q
   67: 	;
   68: ENTRY	; PROCESS ONE FILE ENTRY
   69: 	S DIFG(DILL,"NAV")=1
   70: 	D LOOKUP^DIFGGU
   71: 	K DIFG(DILL,"NAV")
   72: 	I $D(DIFGGUQ) K DIFGGUQ Q
   73: 	S DITAB=DITAB+2
   74: 	D ^DIFGG2
   75: 	D RECURSEF
   76: 	S DITAB=2*(DILL-1)
   77: 	S V=":" D INCSET^DIFGGU
   78: 	Q
   79: 	;
   80: RECURSEF	; RECURSION FOR DEEPER FILE SHIFTS
   81: 	D NEXTLVL^DIFGG
   82: 	Q