| [613] | 1 | DIFGG4 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM SUBFILES ;6/10/93 1:41 PM
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
