- DIAXD ;SFISC/DCM-GET SOURCE DATA ;9/6/96 15:17
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- EN ;
- N DILL,FRFILE,TOFILE,DIAXIEN,DIAXI,DIAXFR,DIAXTO,DATAFR,DATALST,Z
- S (DILL,DIAXI)=$G(DILL)+1,FRFILE=@DIAXTFR@(DILL,"FR"),TOFILE=@DIAXTFR@(FRFILE,"TO"),Z=","
- S DIAXFR="^TMP($J,""DIAXFR"")",DIAXTO="^TMP($J,""DIAXTO"")",DATAFR="^TMP($J,""DATAFR"")",DATALST="^TMP($J,""DATALST"")"
- D Q,TOP I $G(DIERR) D Q Q
- D NEXTLVL
- Q K @DIAXFR,@DIAXTO,@DATAFR
- K:$G(DIERR) ^TMP("DIAX",$J)
- Q
- TOP ;
- N FRIENS,TOIENS
- S (FRIENS,@DIAXFR@(FRFILE,"IENS"))=DIAXFE_Z
- S (TOIENS,@DIAXTO@(TOFILE,"IENS"),@DIAXTO@(FRFILE,"IENS",FRIENS))=$$DIAXIEN()
- D GETFDA(FRIENS,TOIENS)
- Q
- GETFDA(FRIENS,TOIENS) ;
- D GETS Q:$G(DIERR)
- D FDA
- Q
- GETS ;
- N DR,FLAGS,FIELDS
- F S DR=$G(DR)+1 Q:'$G(@DIAXTFR@(FRFILE,"DR",DR)) D Q:$G(DIERR)
- . S FLAGS="EIN"
- . S FIELDS=@DIAXTFR@(FRFILE,"DR",DR)
- . D GETS^DIQ(FRFILE,FRIENS,FIELDS,FLAGS,DATAFR,DIAXERR) D:$G(DIERR) ERR
- Q
- FDA ;
- N A,B,C S A=0
- F S A=$O(@DATAFR@(FRFILE,FRIENS,A)) Q:A'>0 F C=0,1 S B=$G(@DIAXTTO@(FRFILE,A,C)) D:B]"" Q:$G(DIERR)
- . I $O(@DATAFR@(FRFILE,FRIENS,A,0)) S ^TMP("DIAX",$J,TOFILE,TOIENS,+$P(B,U,2))=U_$P($$GET1^DIQ(FRFILE,FRIENS,A,"B"),U,2) Q
- . S ^TMP("DIAX",$J,TOFILE,TOIENS,+$P(B,U,2))=$S(+$P(B,U,3):@DATAFR@(FRFILE,FRIENS,A,"E"),1:@DATAFR@(FRFILE,FRIENS,A,"I"))
- I '$D(^TMP("DIAX",$J,TOFILE,TOIENS,.01)) S ^TMP("DIAX",$J,TOFILE,TOIENS,.01)=$$GET1^DIQ(FRFILE,FRIENS,.01,"I","",DIAXERR) D:$G(DIERR) ERR
- K @DATAFR
- Q
- GETLIST ;
- N SCR,A,B S SCR=$G(DIAXSCR(FRFILE))
- S FRIENS=$G(FRIENS),PART=$G(PART),INDEX=$G(INDEX) K @DATALST
- D LIST^DIC(FRFILE,FRIENS,"","","","",PART,INDEX,.SCR,"",DATALST,DIAXERR)
- I $G(DIERR) D ERR,Q1 Q
- I '$P(@DATALST@("DILIST",0),U) D Q1 Q
- I $G(PART)]"" S FRIENS=Z_@DIAXFR@(PARENT,"IENS")
- S A=0 F S A=$O(@DATALST@("DILIST",2,A)) Q:A'>0 S B=@DATALST@("DILIST",2,A),@DIAXFR@(FRFILE,"IENS",$E(FRIENS,2,99),B_FRIENS)=""
- Q1 K @DATALST,PART,INDEX
- Q
- TOIENS ;
- N A,B S A=""
- F S A=$O(@DIAXFR@(FRFILE,"IENS",FRIENS,A)) Q:A="" S B=$$DIAXIEN(),@DIAXTO@(FRFILE,"IENS",A)=B_@DIAXTO@(PARENT,"IENS",FRIENS)
- Q
- GETDATA ;
- Q:'$D(@DIAXTFR@(FRFILE,"DR"))
- N A,ZFRIENS S A="",ZFRIENS=FRIENS N FRIENS
- F S A=$O(@DIAXFR@(FRFILE,"IENS",ZFRIENS,A)) Q:A="" S FRIENS=A D Q:$G(DIERR)
- . N TOIENS
- . S TOIENS=@DIAXTO@(FRFILE,"IENS",FRIENS)
- . D GETFDA(FRIENS,TOIENS) Q:$G(DIERR)
- . I $D(DIAXFILE(FRFILE)) D Q
- . . N Y,DIERZ
- . . D RECURSE
- . . I $G(DIERZ) N DIERR,Y S Y("IEN")=DIAXFE D BLD^DIALOG(1300,"",.Y) D STE^DIAXU()
- Q
- MULT(FRIENS) ;
- S FRIENS=Z_FRIENS
- D GETLIST Q:$G(DIERR)
- S FRIENS=$E(FRIENS,2,99)
- D TOIENS
- D GETDATA
- Q
- ERR ;
- Q:'$D(FRFILE)!('$D(FRIENS))
- Q:'$D(DIAXFILE(FRFILE))
- D STE^DIAXU(FRFILE,FRIENS)
- Q
- NEXTLVL ;
- F DIAXI=$G(DIAXI):0 S DIAXI=$O(@DIAXTFR@(DIAXI)) Q:'$D(@DIAXTFR@(+DIAXI,"FR")) D NEXTLVL2 Q:$G(DIERR)!(DIAXI="")
- Q
- NEXTLVL2 ;
- N FRFILE,TOFILE,PARENT,DILL,FRIENS,TOIENS,TAG
- S FRFILE=@DIAXTFR@(DIAXI,"FR"),TOFILE=@DIAXTFR@(FRFILE,"TO"),PARENT=^("PRT"),DILL=^("P2"),TAG=^("P4")
- D @TAG
- Q
- 3 ;
- I $D(DIAXFILE(FRFILE)) D FILE Q:$G(DIERR)
- I DILL=2 S FRIENS=@DIAXFR@(PARENT,"IENS") D MULT(FRIENS) Q
- N A,B S (A,B)="" F S B=$O(@DIAXFR@(PARENT,"IENS",B)) Q:B="" D
- . F S A=$O(@DIAXFR@(PARENT,"IENS",B,A)) Q:A="" D Q:$D(DIAXFILE(PARENT))
- . . S FRIENS=A D MULT(FRIENS) Q:$G(DIERR)
- Q
- 2 ;
- N PTRFLD,FRIENS,PTRIEN,A,B
- S PTRFLD=$P(@DIAXTFR@(FRFILE,"P5"),":")
- I DILL=2 S FRIENS=@DIAXFR@(PARENT,"IENS") D 21 Q
- S (A,B)="" F S B=$O(@DIAXFR@(PARENT,"IENS",B)) Q:B="" D Q:$G(DIERR)!('PTRIEN)
- . F S A=$O(@DIAXFR@(PARENT,"IENS",B,A)) Q:A="" D Q:$G(DIERR)!'(PTRIEN)!($D(DIAXFILE(PARENT)))
- . . S FRIENS=A D 21
- Q
- 21 N TOIENS
- S PTRIEN=$$GET1^DIQ(PARENT,FRIENS,PTRFLD,"I","",DIAXERR) D:$G(DIERR) Q:$G(DIERR)!('PTRIEN)
- . N FRFILE
- . S FRFILE=PARENT
- . D ERR
- S FRIENS=PTRIEN_Z
- S TOIENS=@DIAXTO@(PARENT,"IENS",A)
- D GETFDA(FRIENS,TOIENS)
- Q
- 4 ;
- N PART,INDEX,FRIENS
- S PART=$$GET1^DIQ(PARENT,@DIAXFR@(PARENT,"IENS"),.01,"I","",DIAXERR) D:$G(DIERR) Q:PART']""!$G(DIERR)
- . N FRFILE,FRIENS
- . S FRFILE=PARENT
- . S FRIENS=@DIAXFR@(PARENT,"IENS")
- . D ERR
- S INDEX=@DIAXTFR@(FRFILE,"P7")
- I $D(DIAXFILE(FRFILE)) D FILE Q:$G(DIERR)
- S FRIENS="" D GETLIST Q:$G(DIERR)
- S FRIENS=@DIAXFR@(PARENT,"IENS")
- D TOIENS,GETDATA
- Q
- DIAXIEN() ;
- S DIAXIEN=$G(DIAXIEN)+1
- Q "+"_DIAXIEN_Z
- FILE ;
- Q:'$D(^TMP("DIAX",$J))
- N IEN S IEN="^TMP($J,""IEN"")"
- D Q2,UPDATE^DIE("E","^TMP(""DIAX"",$J)",IEN,DIAXERR)
- I $G(DIERR) D Q
- . K ^TMP("DIAX",$J)
- . D ERR
- N %,NODE,A,B,FI,VAL,DA S %=0,NODE=DIAXTO
- I $G(@IEN@(1)) S DIAXDA=^(1),FI=0,FI=$O(@NODE@(FI))
- E S FI=FRFILE
- F S %=$O(@IEN@(%)) Q:'% S DA=@IEN@(%) D VAL
- Q2 K @IEN Q
- VAL S NODE=DIAXTO,NODE=$NA(@NODE@(FI)) F S NODE=$Q(@NODE) Q:NODE'["DIAXTO" Q:$QS(NODE,5)'[$G(FRIENS) S VAL=@NODE I VAL[("+"_%_Z) S VAL=$P(VAL,"+"_%_Z,1)_DA_Z_$P(VAL,"+"_%_Z,2) S @NODE=VAL D
- . S A=$QS(NODE,3),B=$QS(NODE,5)
- . Q:(A'=DIAXF)&('$D(DIAXFILE(A)))
- . Q:A=""!(B="")
- . I A=DIAXF S B=+B,VAL=+VAL
- . S @DIAXRSLT@("RESULT",A,B)=VAL
- Q
- RECURSE ;
- N DIAXIZ,DILLZ,DIERR
- S DIAXIZ=DIAXI,DILLZ=DILL
- D NEXTLVL,FILE
- N NODE,SUB,FILE S FILE=FRFILE
- F S FILE=$O(@DIAXFR@(FILE)) Q:'FILE F NODE=$NA(@DIAXFR@(FILE)),$NA(@DIAXTO@(FILE)) F S NODE=$Q(@NODE) Q:NODE'["IENS" S SUB=$QS(NODE,5) I SUB[FRIENS K @NODE
- K @DIAXFR@(FRFILE,"IENS",ZFRIENS,FRIENS),@DIAXTO@(FRFILE,"IENS",FRIENS)
- S DIAXI=DIAXIZ,DILL=DILLZ,A=""
- I $G(DIERR) K DIAXDA S DIERZ=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIAXD 5748 printed Mar 13, 2025@21:49:46 Page 2
- DIAXD ;SFISC/DCM-GET SOURCE DATA ;9/6/96 15:17
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- EN ;
- +1 NEW DILL,FRFILE,TOFILE,DIAXIEN,DIAXI,DIAXFR,DIAXTO,DATAFR,DATALST,Z
- +2 SET (DILL,DIAXI)=$GET(DILL)+1
- SET FRFILE=@DIAXTFR@(DILL,"FR")
- SET TOFILE=@DIAXTFR@(FRFILE,"TO")
- SET Z=","
- +3 SET DIAXFR="^TMP($J,""DIAXFR"")"
- SET DIAXTO="^TMP($J,""DIAXTO"")"
- SET DATAFR="^TMP($J,""DATAFR"")"
- SET DATALST="^TMP($J,""DATALST"")"
- +4 DO Q
- DO TOP
- IF $GET(DIERR)
- DO Q
- QUIT
- +5 DO NEXTLVL
- Q KILL @DIAXFR,@DIAXTO,@DATAFR
- +1 if $GET(DIERR)
- KILL ^TMP("DIAX",$JOB)
- +2 QUIT
- TOP ;
- +1 NEW FRIENS,TOIENS
- +2 SET (FRIENS,@DIAXFR@(FRFILE,"IENS"))=DIAXFE_Z
- +3 SET (TOIENS,@DIAXTO@(TOFILE,"IENS"),@DIAXTO@(FRFILE,"IENS",FRIENS))=$$DIAXIEN()
- +4 DO GETFDA(FRIENS,TOIENS)
- +5 QUIT
- GETFDA(FRIENS,TOIENS) ;
- +1 DO GETS
- if $GET(DIERR)
- QUIT
- +2 DO FDA
- +3 QUIT
- GETS ;
- +1 NEW DR,FLAGS,FIELDS
- +2 FOR
- SET DR=$GET(DR)+1
- if '$GET(@DIAXTFR@(FRFILE,"DR",DR))
- QUIT
- Begin DoDot:1
- +3 SET FLAGS="EIN"
- +4 SET FIELDS=@DIAXTFR@(FRFILE,"DR",DR)
- +5 DO GETS^DIQ(FRFILE,FRIENS,FIELDS,FLAGS,DATAFR,DIAXERR)
- if $GET(DIERR)
- DO ERR
- End DoDot:1
- if $GET(DIERR)
- QUIT
- +6 QUIT
- FDA ;
- +1 NEW A,B,C
- SET A=0
- +2 FOR
- SET A=$ORDER(@DATAFR@(FRFILE,FRIENS,A))
- if A'>0
- QUIT
- FOR C=0,1
- SET B=$GET(@DIAXTTO@(FRFILE,A,C))
- if B]""
- Begin DoDot:1
- +3 IF $ORDER(@DATAFR@(FRFILE,FRIENS,A,0))
- SET ^TMP("DIAX",$JOB,TOFILE,TOIENS,+$PIECE(B,U,2))=U_$PIECE($$GET1^DIQ(FRFILE,FRIENS,A,"B"),U,2)
- QUIT
- +4 SET ^TMP("DIAX",$JOB,TOFILE,TOIENS,+$PIECE(B,U,2))=$SELECT(+$PIECE(B,U,3):@DATAFR@(FRFILE,FRIENS,A,"E"),1:@DATAFR@(FRFILE,FRIENS,A,"I"))
- End DoDot:1
- if $GET(DIERR)
- QUIT
- +5 IF '$DATA(^TMP("DIAX",$JOB,TOFILE,TOIENS,.01))
- SET ^TMP("DIAX",$JOB,TOFILE,TOIENS,.01)=$$GET1^DIQ(FRFILE,FRIENS,.01,"I","",DIAXERR)
- if $GET(DIERR)
- DO ERR
- +6 KILL @DATAFR
- +7 QUIT
- GETLIST ;
- +1 NEW SCR,A,B
- SET SCR=$GET(DIAXSCR(FRFILE))
- +2 SET FRIENS=$GET(FRIENS)
- SET PART=$GET(PART)
- SET INDEX=$GET(INDEX)
- KILL @DATALST
- +3 DO LIST^DIC(FRFILE,FRIENS,"","","","",PART,INDEX,.SCR,"",DATALST,DIAXERR)
- +4 IF $GET(DIERR)
- DO ERR
- DO Q1
- QUIT
- +5 IF '$PIECE(@DATALST@("DILIST",0),U)
- DO Q1
- QUIT
- +6 IF $GET(PART)]""
- SET FRIENS=Z_@DIAXFR@(PARENT,"IENS")
- +7 SET A=0
- FOR
- SET A=$ORDER(@DATALST@("DILIST",2,A))
- if A'>0
- QUIT
- SET B=@DATALST@("DILIST",2,A)
- SET @DIAXFR@(FRFILE,"IENS",$EXTRACT(FRIENS,2,99),B_FRIENS)=""
- Q1 KILL @DATALST,PART,INDEX
- +1 QUIT
- TOIENS ;
- +1 NEW A,B
- SET A=""
- +2 FOR
- SET A=$ORDER(@DIAXFR@(FRFILE,"IENS",FRIENS,A))
- if A=""
- QUIT
- SET B=$$DIAXIEN()
- SET @DIAXTO@(FRFILE,"IENS",A)=B_@DIAXTO@(PARENT,"IENS",FRIENS)
- +3 QUIT
- GETDATA ;
- +1 if '$DATA(@DIAXTFR@(FRFILE,"DR"))
- QUIT
- +2 NEW A,ZFRIENS
- SET A=""
- SET ZFRIENS=FRIENS
- NEW FRIENS
- +3 FOR
- SET A=$ORDER(@DIAXFR@(FRFILE,"IENS",ZFRIENS,A))
- if A=""
- QUIT
- SET FRIENS=A
- Begin DoDot:1
- +4 NEW TOIENS
- +5 SET TOIENS=@DIAXTO@(FRFILE,"IENS",FRIENS)
- +6 DO GETFDA(FRIENS,TOIENS)
- if $GET(DIERR)
- QUIT
- +7 IF $DATA(DIAXFILE(FRFILE))
- Begin DoDot:2
- +8 NEW Y,DIERZ
- +9 DO RECURSE
- +10 IF $GET(DIERZ)
- NEW DIERR,Y
- SET Y("IEN")=DIAXFE
- DO BLD^DIALOG(1300,"",.Y)
- DO STE^DIAXU()
- End DoDot:2
- QUIT
- End DoDot:1
- if $GET(DIERR)
- QUIT
- +11 QUIT
- MULT(FRIENS) ;
- +1 SET FRIENS=Z_FRIENS
- +2 DO GETLIST
- if $GET(DIERR)
- QUIT
- +3 SET FRIENS=$EXTRACT(FRIENS,2,99)
- +4 DO TOIENS
- +5 DO GETDATA
- +6 QUIT
- ERR ;
- +1 if '$DATA(FRFILE)!('$DATA(FRIENS))
- QUIT
- +2 if '$DATA(DIAXFILE(FRFILE))
- QUIT
- +3 DO STE^DIAXU(FRFILE,FRIENS)
- +4 QUIT
- NEXTLVL ;
- +1 FOR DIAXI=$GET(DIAXI):0
- SET DIAXI=$ORDER(@DIAXTFR@(DIAXI))
- if '$DATA(@DIAXTFR@(+DIAXI,"FR"))
- QUIT
- DO NEXTLVL2
- if $GET(DIERR)!(DIAXI="")
- QUIT
- +2 QUIT
- NEXTLVL2 ;
- +1 NEW FRFILE,TOFILE,PARENT,DILL,FRIENS,TOIENS,TAG
- +2 SET FRFILE=@DIAXTFR@(DIAXI,"FR")
- SET TOFILE=@DIAXTFR@(FRFILE,"TO")
- SET PARENT=^("PRT")
- SET DILL=^("P2")
- SET TAG=^("P4")
- +3 DO @TAG
- +4 QUIT
- 3 ;
- +1 IF $DATA(DIAXFILE(FRFILE))
- DO FILE
- if $GET(DIERR)
- QUIT
- +2 IF DILL=2
- SET FRIENS=@DIAXFR@(PARENT,"IENS")
- DO MULT(FRIENS)
- QUIT
- +3 NEW A,B
- SET (A,B)=""
- FOR
- SET B=$ORDER(@DIAXFR@(PARENT,"IENS",B))
- if B=""
- QUIT
- Begin DoDot:1
- +4 FOR
- SET A=$ORDER(@DIAXFR@(PARENT,"IENS",B,A))
- if A=""
- QUIT
- Begin DoDot:2
- +5 SET FRIENS=A
- DO MULT(FRIENS)
- if $GET(DIERR)
- QUIT
- End DoDot:2
- if $DATA(DIAXFILE(PARENT))
- QUIT
- End DoDot:1
- +6 QUIT
- 2 ;
- +1 NEW PTRFLD,FRIENS,PTRIEN,A,B
- +2 SET PTRFLD=$PIECE(@DIAXTFR@(FRFILE,"P5"),":")
- +3 IF DILL=2
- SET FRIENS=@DIAXFR@(PARENT,"IENS")
- DO 21
- QUIT
- +4 SET (A,B)=""
- FOR
- SET B=$ORDER(@DIAXFR@(PARENT,"IENS",B))
- if B=""
- QUIT
- Begin DoDot:1
- +5 FOR
- SET A=$ORDER(@DIAXFR@(PARENT,"IENS",B,A))
- if A=""
- QUIT
- Begin DoDot:2
- +6 SET FRIENS=A
- DO 21
- End DoDot:2
- if $GET(DIERR)!'(PTRIEN)!($DATA(DIAXFILE(PARENT)))
- QUIT
- End DoDot:1
- if $GET(DIERR)!('PTRIEN)
- QUIT
- +7 QUIT
- 21 NEW TOIENS
- +1 SET PTRIEN=$$GET1^DIQ(PARENT,FRIENS,PTRFLD,"I","",DIAXERR)
- if $GET(DIERR)
- Begin DoDot:1
- +2 NEW FRFILE
- +3 SET FRFILE=PARENT
- +4 DO ERR
- End DoDot:1
- if $GET(DIERR)!('PTRIEN)
- QUIT
- +5 SET FRIENS=PTRIEN_Z
- +6 SET TOIENS=@DIAXTO@(PARENT,"IENS",A)
- +7 DO GETFDA(FRIENS,TOIENS)
- +8 QUIT
- 4 ;
- +1 NEW PART,INDEX,FRIENS
- +2 SET PART=$$GET1^DIQ(PARENT,@DIAXFR@(PARENT,"IENS"),.01,"I","",DIAXERR)
- if $GET(DIERR)
- Begin DoDot:1
- +3 NEW FRFILE,FRIENS
- +4 SET FRFILE=PARENT
- +5 SET FRIENS=@DIAXFR@(PARENT,"IENS")
- +6 DO ERR
- End DoDot:1
- if PART']""!$GET(DIERR)
- QUIT
- +7 SET INDEX=@DIAXTFR@(FRFILE,"P7")
- +8 IF $DATA(DIAXFILE(FRFILE))
- DO FILE
- if $GET(DIERR)
- QUIT
- +9 SET FRIENS=""
- DO GETLIST
- if $GET(DIERR)
- QUIT
- +10 SET FRIENS=@DIAXFR@(PARENT,"IENS")
- +11 DO TOIENS
- DO GETDATA
- +12 QUIT
- DIAXIEN() ;
- +1 SET DIAXIEN=$GET(DIAXIEN)+1
- +2 QUIT "+"_DIAXIEN_Z
- FILE ;
- +1 if '$DATA(^TMP("DIAX",$JOB))
- QUIT
- +2 NEW IEN
- SET IEN="^TMP($J,""IEN"")"
- +3 DO Q2
- DO UPDATE^DIE("E","^TMP(""DIAX"",$J)",IEN,DIAXERR)
- +4 IF $GET(DIERR)
- Begin DoDot:1
- +5 KILL ^TMP("DIAX",$JOB)
- +6 DO ERR
- End DoDot:1
- QUIT
- +7 NEW %,NODE,A,B,FI,VAL,DA
- SET %=0
- SET NODE=DIAXTO
- +8 IF $GET(@IEN@(1))
- SET DIAXDA=^(1)
- SET FI=0
- SET FI=$ORDER(@NODE@(FI))
- +9 IF '$TEST
- SET FI=FRFILE
- +10 FOR
- SET %=$ORDER(@IEN@(%))
- if '%
- QUIT
- SET DA=@IEN@(%)
- DO VAL
- Q2 KILL @IEN
- QUIT
- VAL SET NODE=DIAXTO
- SET NODE=$NAME(@NODE@(FI))
- FOR
- SET NODE=$QUERY(@NODE)
- if NODE'["DIAXTO"
- QUIT
- if $QSUBSCRIPT(NODE,5)'[$GET(FRIENS)
- QUIT
- SET VAL=@NODE
- IF VAL[("+"_%_Z)
- SET VAL=$PIECE(VAL,"+"_%_Z,1)_DA_Z_$PIECE(VAL,"+"_%_Z,2)
- SET @NODE=VAL
- Begin DoDot:1
- +1 SET A=$QSUBSCRIPT(NODE,3)
- SET B=$QSUBSCRIPT(NODE,5)
- +2 if (A'=DIAXF)&('$DATA(DIAXFILE(A)))
- QUIT
- +3 if A=""!(B="")
- QUIT
- +4 IF A=DIAXF
- SET B=+B
- SET VAL=+VAL
- +5 SET @DIAXRSLT@("RESULT",A,B)=VAL
- End DoDot:1
- +6 QUIT
- RECURSE ;
- +1 NEW DIAXIZ,DILLZ,DIERR
- +2 SET DIAXIZ=DIAXI
- SET DILLZ=DILL
- +3 DO NEXTLVL
- DO FILE
- +4 NEW NODE,SUB,FILE
- SET FILE=FRFILE
- +5 FOR
- SET FILE=$ORDER(@DIAXFR@(FILE))
- if 'FILE
- QUIT
- FOR NODE=$NAME(@DIAXFR@(FILE)),$NAME(@DIAXTO@(FILE))
- FOR
- SET NODE=$QUERY(@NODE)
- if NODE'["IENS"
- QUIT
- SET SUB=$QSUBSCRIPT(NODE,5)
- IF SUB[FRIENS
- KILL @NODE
- +6 KILL @DIAXFR@(FRFILE,"IENS",ZFRIENS,FRIENS),@DIAXTO@(FRFILE,"IENS",FRIENS)
- +7 SET DIAXI=DIAXIZ
- SET DILL=DILLZ
- SET A=""
- +8 IF $GET(DIERR)
- KILL DIAXDA
- SET DIERZ=1
- +9 QUIT
