- DIFGG4 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM SUBFILES ;6/10/93 1:41 PM
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- SUBFILE ; DO ONE SUBFILE
- 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
- Q
- ;
- SUBENTRY ; DO ONE SUBFILE ENTRY
- D DIS Q:'$T
- D DR S DR(DIFG(DILL,"FILE"))=.01
- S DIFG(DILL,"MUL")=1
- D LOOKUP^DIFGGU
- I $D(DIFGGUQ) K DIFGGUQ,DIFG(DILL,"MUL") Q
- D DR,DRS
- D RECURSEM
- S V="^" D INCSET^DIFGGU
- K DIFG(DILL,"MUL"),DA,DR
- Q
- ;
- DR ; CREATE DR-STRINGS
- K DR S I=0
- 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
- S DA=DIFG(DILL-I,"FE"),DIC=DIFG(DILL-I,"FILE"),DR=DR(%) K DR(%)
- Q
- ;
- DRS ; PROCESS ALL DR STRINGS FOR FILE
- S DR(DIFG(DILL,"FILE"))="",DITAB=DITAB+2
- 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
- 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"))=""
- D EN^DIFGG2:DR(DIFG(DILL,"FILE"))]""
- S DITAB=DITAB-2
- Q
- ;
- DRA ;Process all subfields
- 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(%)=""
- Q
- ;
- DIS ; SCREEN THIS ENTRY
- F %=1:1:DILL S @("D"_(%-1))=DIFG(%,"FE")
- I $D(DIFG(DIFG(DILL,"FILE"),"S"))#2 X DIFG(DIFG(DILL,"FILE"),"S") Q
- I 1 Q
- ;
- RECURSEM ; RECURSION FOR DEEPER SUBFILE SHIFTS
- S DITAB=DITAB+2
- D NEXTLVL^DIFGG
- S DITAB=DITAB-2
- Q
- ;
- ;
- DIFGG3 ; FILEGRAM NAVIGATION
- ; SEE DIFGG3^DIFGGDOC
- ;
- FILE ; PROCESS ONE FILE
- F DIFG(DILL,"FE")=0:0 D FILE2 Q:DIFG(DILL,"FE")="" D ENTRY
- K I,S,V,X
- Q
- ;
- FILE2 ;
- S X=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),0))
- Q:'X
- S Y=$O(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),X,0))
- Q:'Y
- 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
- E S DIFG(DILL,"FSV")=DIFG(DILL-1,"FE")
- S DIFG(DILL,"FE")=$O(@(DIFG(DILL,"FGBL")_""""_DIFG(DILL,"XREF")_""","_DIFG(DILL,"FSV")_","_DIFG(DILL,"FE")_")"))
- Q
- ;
- ENTRY ; PROCESS ONE FILE ENTRY
- S DIFG(DILL,"NAV")=1
- D LOOKUP^DIFGGU
- K DIFG(DILL,"NAV")
- I $D(DIFGGUQ) K DIFGGUQ Q
- S DITAB=DITAB+2
- D ^DIFGG2
- D RECURSEF
- S DITAB=2*(DILL-1)
- S V=":" D INCSET^DIFGGU
- Q
- ;
- RECURSEF ; RECURSION FOR DEEPER FILE SHIFTS
- D NEXTLVL^DIFGG
- Q
- DIFGG4 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM SUBFILES ;6/10/93 1:41 PM
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- SUBFILE ; DO ONE SUBFILE
- +1 FOR DIFG(DILL,"FE")=0:0
- SET DIFG(DILL,"FE")=$ORDER(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_")"))
- IF DIFG(DILL,"FE")'=+DIFG(DILL,"FE")
- QUIT
- DO SUBENTRY
- +2 QUIT
- +3 ;
- SUBENTRY ; DO ONE SUBFILE ENTRY
- +1 DO DIS
- IF '$TEST
- QUIT
- +2 DO DR
- SET DR(DIFG(DILL,"FILE"))=.01
- +3 SET DIFG(DILL,"MUL")=1
- +4 DO LOOKUP^DIFGGU
- +5 IF $DATA(DIFGGUQ)
- KILL DIFGGUQ,DIFG(DILL,"MUL")
- QUIT
- +6 DO DR
- DO DRS
- +7 DO RECURSEM
- +8 SET V="^"
- DO INCSET^DIFGGU
- +9 KILL DIFG(DILL,"MUL"),DA,DR
- +10 QUIT
- +11 ;
- DR ; CREATE DR-STRINGS
- +1 KILL DR
- SET I=0
- +2 FOR %=DIFG(DILL,"FILE"):0
- IF '$DATA(^DD(%,0,"UP"))
- QUIT
- SET X=^("UP")
- SET Y=$ORDER(^DD(X,"SB",%,0))
- SET DR(X)=Y
- SET DA(%)=DIFG(DILL-I,"FE")
- SET %=X
- SET I=I+1
- +3 SET DA=DIFG(DILL-I,"FE")
- SET DIC=DIFG(DILL-I,"FILE")
- SET DR=DR(%)
- KILL DR(%)
- +4 QUIT
- +5 ;
- DRS ; PROCESS ALL DR STRINGS FOR FILE
- +1 SET DR(DIFG(DILL,"FILE"))=""
- SET DITAB=DITAB+2
- +2 IF $PIECE(^DIPT(DIFGT,1,DIFGI,0),U,8)
- FOR DIFG2=.001:0
- SET %=DIFG(DILL,"FILE")
- SET DIFG2=$ORDER(^DD(%,DIFG2))
- IF DIFG2'>0
- QUIT
- DO DRA
- +3 FOR DIFG2=0:0
- SET DIFG2=$ORDER(^DIPT(DIFGT,1,DIFGI,"F",DIFG2))
- IF DIFG2'=+DIFG2
- QUIT
- IF $DATA(^(DIFG2,0))
- SET DR(DIFG(DILL,"FILE"))=DR(DIFG(DILL,"FILE"))_^(0)_";"
- IF $LENGTH(DR(DIFG(DILL,"FILE")))>200
- DO EN^DIFGG2
- SET DR(DIFG(DILL,"FILE"))=""
- +4 IF DR(DIFG(DILL,"FILE"))]""
- DO EN^DIFGG2
- +5 SET DITAB=DITAB-2
- +6 QUIT
- +7 ;
- DRA ;Process all subfields
- +1 SET %1=$PIECE(^(0),U,0)
- IF $SELECT('%1:%1'["C",1:$PIECE(^DD(+%1,.01,0),U,2)["W")
- SET DR(%)=DR(%)_DIFG2_";"
- IF $LENGTH(DR(%))>200
- DO EN^DIFGG2
- SET %=DIFG(DILL,"FILE")
- SET DR(%)=""
- +2 QUIT
- +3 ;
- DIS ; SCREEN THIS ENTRY
- +1 FOR %=1:1:DILL
- SET @("D"_(%-1))=DIFG(%,"FE")
- +2 IF $DATA(DIFG(DIFG(DILL,"FILE"),"S"))#2
- XECUTE DIFG(DIFG(DILL,"FILE"),"S")
- QUIT
- +3 IF 1
- QUIT
- +4 ;
- RECURSEM ; RECURSION FOR DEEPER SUBFILE SHIFTS
- +1 SET DITAB=DITAB+2
- +2 DO NEXTLVL^DIFGG
- +3 SET DITAB=DITAB-2
- +4 QUIT
- +5 ;
- +6 ;
- DIFGG3 ; FILEGRAM NAVIGATION
- +1 ; SEE DIFGG3^DIFGGDOC
- +2 ;
- FILE ; PROCESS ONE FILE
- +1 FOR DIFG(DILL,"FE")=0:0
- DO FILE2
- IF DIFG(DILL,"FE")=""
- QUIT
- DO ENTRY
- +2 KILL I,S,V,X
- +3 QUIT
- +4 ;
- FILE2 ;
- +1 SET X=$ORDER(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),0))
- +2 IF 'X
- QUIT
- +3 SET Y=$ORDER(^DD(DIFG(DILL,"FILE"),0,"IX",DIFG(DILL,"XREF"),X,0))
- +4 IF 'Y
- QUIT
- +5 IF $PIECE(^DD(X,Y,0),U,2)["V"
- SET DIFG(DILL,"FSV")=""""_DIFG(DILL-1,"FE")_";"_$PIECE(^DIC(DIFG(DILL-1,"FILE"),0,"GL"),U,2)_""""
- IF 1
- +6 IF '$TEST
- SET DIFG(DILL,"FSV")=DIFG(DILL-1,"FE")
- +7 SET DIFG(DILL,"FE")=$ORDER(@(DIFG(DILL,"FGBL")_""""_DIFG(DILL,"XREF")_""","_DIFG(DILL,"FSV")_","_DIFG(DILL,"FE")_")"))
- +8 QUIT
- +9 ;
- ENTRY ; PROCESS ONE FILE ENTRY
- +1 SET DIFG(DILL,"NAV")=1
- +2 DO LOOKUP^DIFGGU
- +3 KILL DIFG(DILL,"NAV")
- +4 IF $DATA(DIFGGUQ)
- KILL DIFGGUQ
- QUIT
- +5 SET DITAB=DITAB+2
- +6 DO ^DIFGG2
- +7 DO RECURSEF
- +8 SET DITAB=2*(DILL-1)
- +9 SET V=":"
- DO INCSET^DIFGGU
- +10 QUIT
- +11 ;
- RECURSEF ; RECURSION FOR DEEPER FILE SHIFTS
- +1 DO NEXTLVL^DIFGG
- +2 QUIT
