BGUGDE ; IHS/OIT/MJL - GET FILE DICTIONARY ELEMENTS ;
;;1.5;BGU;;MAY 26, 2005
EN(BGUARRAY,BGUFILE,BGUVLST,BGUFATT) ;PEP FROM REMOTE PROCEDURE BGU GETDE
Q:BGUFILE="" S BGUFILE=$$GETGBL(BGUFILE) Q:BGUFILE=""
D INIT
I BGUVLST'="" S BGUPFX="" F BGUN=1:1:$L(BGUVLST,",") S BGUFN=$P($P(BGUVLST,",",BGUN),"-") D
.S BGUPFX=""
.I $E(BGUFN)="F" S BGUPFX=$P(BGUFN,":",1)_":",BGUFILE1=+$P(BGUFN,"F",2),BGUVLST1=$P(BGUFN,":",3) D Q
..F BGUNN=1:1:$L(BGUVLST1,"~") S BGUFN1=$P(BGUVLST1,"~",BGUNN) D GETDDI(BGUFILE1,BGUFN1)
.D GETDDI(BGUFILE,BGUFN)
I BGUVLST="" S BGUFN=0 F S BGUFN=$O(^DD(BGUFILE,BGUFN)) Q:'BGUFN D GCMPDDI(BGUFILE,BGUFN)
D SETDATA(BGUCNT,0)
D KILL
Q
;
INIT ;
S XWBWRAP=1
S U="^",BGUFILE=$G(BGUFILE),BGUARRAY=$G(BGUARRAY),BGUFATT=$G(BGUFATT),BGUCNT=0
;S BGUVLST=$G(BGUVLST),BGUARRAY="^TMP(""BGULIST"","_$J_")"
S BGUVLST=$G(BGUVLST),BGUARRAY=$NA(@"^TMP(""BGULIST"",$J)")
K @BGUARRAY
Q
GETGBL(BGUX) ;INTERNAL EP
S:'BGUX BGUX=$O(^DIC("B",BGUX,"")) Q:BGUX="" BGUX
I '$D(^DIC(BGUX)) Q ""
Q BGUX
SETDATA(BGUX,BGUXN) ;INTERNAL EP
S ^TMP("BGULIST",$J,BGUXN)=BGUX
Q
GETDDI(BGUXFID,BGUXFN) ;INTERNAL EP
S BGUCNT=BGUCNT+1
I BGUXFN'["!" S BGUX1=$G(^DD(BGUXFID,BGUXFN,0)) D:BGUX1="" SETDATA("SF:"_BGUXFN,BGUCNT):BGUPFX="" Q:BGUX1="" D Q
.S BGUXNM=$P(BGUX1,U),BGUGNODE=$P(BGUX1,U,4),BGUXN=$P(BGUGNODE,";",2),BGUGNODE=$P(BGUGNODE,";")
.;I BGUPFX="" S:BGUGNODE?." " BGUPFX="SF:"
.S:BGUGNODE?." " BGUXFN="SF:"_BGUXFN
.S:BGUFATT BGUXN=BGUXN_U_U_BGUX1
.D SETDATA(BGUPFX_BGUXFN_U_BGUXNM_U_BGUGNODE_U_BGUXN,BGUCNT)
S BGUXFID1=BGUXFID,BGUXSBS="",BGUXSBNS=""
F BGUN2=1:1:$L(BGUXFN,"!") S BGUXFN1=$P(BGUXFN,"!",BGUN2),BGUX1=$G(^DD(BGUXFID1,BGUXFN1,0)) Q:BGUX1="" S BGUGNODE=$P($P(BGUX1,U,4),";") S:BGUN2>1 BGUXSBS=BGUXSBS_"," S BGUXSBS=BGUXSBS_BGUGNODE,BGUXFID1=+$P(BGUX1,U,2)
I BGUX1'="" S BGUXNM=$P(BGUX1,U),BGUXTY=$P(BGUX1,U,2),BGUXN=$P($P(BGUX1,U,4),";",2) D
.;I BGUPFX="" S:BGUGNODE?." " BGUPFX="SF:"
.S:BGUGNODE?." " BGUXFN="SF:"_BGUXFN
.S BGUXN=BGUXN_U_$S(BGUXTY["W":"W",BGUXTY["C":"C",1:"M")
.S:BGUFATT BGUXN=BGUXN_U_BGUX1
.D SETDATA(BGUPFX_BGUXFN_U_BGUXNM_U_BGUXSBS_U_BGUXN,BGUCNT)
I BGUX1="",BGUPFX'="",$E($P(BGUFN,":",2))="""" D
.S BGUXSBS=$P($P(BGUFN,":",2),"~"),BGUXNM="IMPLIED MULTIPLE USING "_BGUXSBS_" XREF",BGUXSBS=$P(BGUXSBS,"""",2)_",0,0",BGUXN=1_U_"M"
.D SETDATA(BGUPFX_BGUXFN_U_BGUXNM_U_BGUXSBS_U_BGUXN,BGUCNT)
K BGUN2,BGUXFID1,BGUXSBNS,BGUXSBS,BGUXTY
Q
GCMPDDI(BGUXFID,BGUXFN) ;INTERNAL EP
S BGUXFLEV=1,BGUXFID(1)=BGUXFID,BGUXFN(1)=BGUXFN
F D Q:BGUXFLEV=1
.I BGUXFLEV>1 S BGUXFN(BGUXFLEV)=$O(^DD(BGUXFID(BGUXFLEV),$G(BGUXFN(BGUXFLEV),0))) I 'BGUXFN(BGUXFLEV) K BGUXFN(BGUXFLEV) S BGUXFLEV=BGUXFLEV-1 Q
.S BGUX1=$G(^DD(BGUXFID(BGUXFLEV),BGUXFN(BGUXFLEV),0)) Q:BGUX1=""
.S BGUXSBS(BGUXFLEV)=$P($P(BGUX1,U,4),";")
.S BGUXFID=+$P(BGUX1,U,2) S:BGUXFID BGUXFLEV=BGUXFLEV+1,BGUXFID(BGUXFLEV)=BGUXFID
.I 'BGUXFID D
..S BGUXSBS="",BGUXCFN=""
..F BGUN=1:1:BGUXFLEV S:BGUN>1 BGUXSBS=BGUXSBS_",",BGUXCFN=BGUXCFN_"!" S BGUXSBS=BGUXSBS_BGUXSBS(BGUN),BGUXCFN=BGUXCFN_BGUXFN(BGUN)
..S BGUXNM=$P(BGUX1,U),BGUXTY=$P(BGUX1,U,2),BGUXN=$P($P(BGUX1,U,4),";",2)_U S:BGUN>1 BGUXN=BGUXN_$S(BGUXTY["W":"W",BGUXTY["C":"C",1:"M")
..S:BGUFATT BGUXN=BGUXN_U_BGUX1
..S:BGUXSBS(BGUN)?." " BGUXCFN="SF:"_BGUXCFN
..S BGUCNT=BGUCNT+1 D SETDATA(BGUPFX_BGUXCFN_U_BGUXNM_U_BGUXSBS_U_BGUXN,BGUCNT)
Q
;
KILL ;
K BGUCNT,BGUFILE,BGUFILE1,BGUFN,BGUFN1,BGUGNODE,BGUN,BGUN1,BGUN2,BGUNN,BGUPFX,BGUVLST,BGUVLST1,BGUX,BGUX1,BGUXCFN,BGUXFID,BGUXFLEV,BGUXFN,BGUXFN1,BGUXLFID,BGUXN,BGUXNM,BGUXSBNS,BGUXSBS,BGUXTY
Q
BGUGDE ; IHS/OIT/MJL - GET FILE DICTIONARY ELEMENTS ;
+1 ;;1.5;BGU;;MAY 26, 2005
EN(BGUARRAY,BGUFILE,BGUVLST,BGUFATT) ;PEP FROM REMOTE PROCEDURE BGU GETDE
+1 IF BGUFILE=""
QUIT
SET BGUFILE=$$GETGBL(BGUFILE)
IF BGUFILE=""
QUIT
+2 DO INIT
+3 IF BGUVLST'=""
SET BGUPFX=""
FOR BGUN=1:1:$LENGTH(BGUVLST,",")
SET BGUFN=$PIECE($PIECE(BGUVLST,",",BGUN),"-")
Begin DoDot:1
+4 SET BGUPFX=""
+5 IF $EXTRACT(BGUFN)="F"
SET BGUPFX=$PIECE(BGUFN,":",1)_":"
SET BGUFILE1=+$PIECE(BGUFN,"F",2)
SET BGUVLST1=$PIECE(BGUFN,":",3)
Begin DoDot:2
+6 FOR BGUNN=1:1:$LENGTH(BGUVLST1,"~")
SET BGUFN1=$PIECE(BGUVLST1,"~",BGUNN)
DO GETDDI(BGUFILE1,BGUFN1)
End DoDot:2
QUIT
+7 DO GETDDI(BGUFILE,BGUFN)
End DoDot:1
+8 IF BGUVLST=""
SET BGUFN=0
FOR
SET BGUFN=$ORDER(^DD(BGUFILE,BGUFN))
IF 'BGUFN
QUIT
DO GCMPDDI(BGUFILE,BGUFN)
+9 DO SETDATA(BGUCNT,0)
+10 DO KILL
+11 QUIT
+12 ;
INIT ;
+1 SET XWBWRAP=1
+2 SET U="^"
SET BGUFILE=$GET(BGUFILE)
SET BGUARRAY=$GET(BGUARRAY)
SET BGUFATT=$GET(BGUFATT)
SET BGUCNT=0
+3 ;S BGUVLST=$G(BGUVLST),BGUARRAY="^TMP(""BGULIST"","_$J_")"
+4 SET BGUVLST=$GET(BGUVLST)
SET BGUARRAY=$NAME(@"^TMP(""BGULIST"",$J)")
+5 KILL @BGUARRAY
+6 QUIT
GETGBL(BGUX) ;INTERNAL EP
+1 IF 'BGUX
SET BGUX=$ORDER(^DIC("B",BGUX,""))
IF BGUX=""
QUIT BGUX
+2 IF '$DATA(^DIC(BGUX))
QUIT ""
+3 QUIT BGUX
SETDATA(BGUX,BGUXN) ;INTERNAL EP
+1 SET ^TMP("BGULIST",$JOB,BGUXN)=BGUX
+2 QUIT
GETDDI(BGUXFID,BGUXFN) ;INTERNAL EP
+1 SET BGUCNT=BGUCNT+1
+2 IF BGUXFN'["!"
SET BGUX1=$GET(^DD(BGUXFID,BGUXFN,0))
IF BGUX1=""
IF BGUPFX=""
DO SETDATA("SF:"_BGUXFN,BGUCNT)
IF BGUX1=""
QUIT
Begin DoDot:1
+3 SET BGUXNM=$PIECE(BGUX1,U)
SET BGUGNODE=$PIECE(BGUX1,U,4)
SET BGUXN=$PIECE(BGUGNODE,";",2)
SET BGUGNODE=$PIECE(BGUGNODE,";")
+4 ;I BGUPFX="" S:BGUGNODE?." " BGUPFX="SF:"
+5 IF BGUGNODE?." "
SET BGUXFN="SF:"_BGUXFN
+6 IF BGUFATT
SET BGUXN=BGUXN_U_U_BGUX1
+7 DO SETDATA(BGUPFX_BGUXFN_U_BGUXNM_U_BGUGNODE_U_BGUXN,BGUCNT)
End DoDot:1
QUIT
+8 SET BGUXFID1=BGUXFID
SET BGUXSBS=""
SET BGUXSBNS=""
+9 FOR BGUN2=1:1:$LENGTH(BGUXFN,"!")
SET BGUXFN1=$PIECE(BGUXFN,"!",BGUN2)
SET BGUX1=$GET(^DD(BGUXFID1,BGUXFN1,0))
IF BGUX1=""
QUIT
SET BGUGNODE=$PIECE($PIECE(BGUX1,U,4),";")
IF BGUN2>1
SET BGUXSBS=BGUXSBS_","
SET BGUXSBS=BGUXSBS_BGUGNODE
SET BGUXFID1=+$PIECE(BGUX1,U,2)
+10 IF BGUX1'=""
SET BGUXNM=$PIECE(BGUX1,U)
SET BGUXTY=$PIECE(BGUX1,U,2)
SET BGUXN=$PIECE($PIECE(BGUX1,U,4),";",2)
Begin DoDot:1
+11 ;I BGUPFX="" S:BGUGNODE?." " BGUPFX="SF:"
+12 IF BGUGNODE?." "
SET BGUXFN="SF:"_BGUXFN
+13 SET BGUXN=BGUXN_U_$SELECT(BGUXTY["W":"W",BGUXTY["C":"C",1:"M")
+14 IF BGUFATT
SET BGUXN=BGUXN_U_BGUX1
+15 DO SETDATA(BGUPFX_BGUXFN_U_BGUXNM_U_BGUXSBS_U_BGUXN,BGUCNT)
End DoDot:1
+16 IF BGUX1=""
IF BGUPFX'=""
IF $EXTRACT($PIECE(BGUFN,":",2))=""""
Begin DoDot:1
+17 SET BGUXSBS=$PIECE($PIECE(BGUFN,":",2),"~")
SET BGUXNM="IMPLIED MULTIPLE USING "_BGUXSBS_" XREF"
SET BGUXSBS=$PIECE(BGUXSBS,"""",2)_",0,0"
SET BGUXN=1_U_"M"
+18 DO SETDATA(BGUPFX_BGUXFN_U_BGUXNM_U_BGUXSBS_U_BGUXN,BGUCNT)
End DoDot:1
+19 KILL BGUN2,BGUXFID1,BGUXSBNS,BGUXSBS,BGUXTY
+20 QUIT
GCMPDDI(BGUXFID,BGUXFN) ;INTERNAL EP
+1 SET BGUXFLEV=1
SET BGUXFID(1)=BGUXFID
SET BGUXFN(1)=BGUXFN
+2 FOR
Begin DoDot:1
+3 IF BGUXFLEV>1
SET BGUXFN(BGUXFLEV)=$ORDER(^DD(BGUXFID(BGUXFLEV),$GET(BGUXFN(BGUXFLEV),0)))
IF 'BGUXFN(BGUXFLEV)
KILL BGUXFN(BGUXFLEV)
SET BGUXFLEV=BGUXFLEV-1
QUIT
+4 SET BGUX1=$GET(^DD(BGUXFID(BGUXFLEV),BGUXFN(BGUXFLEV),0))
IF BGUX1=""
QUIT
+5 SET BGUXSBS(BGUXFLEV)=$PIECE($PIECE(BGUX1,U,4),";")
+6 SET BGUXFID=+$PIECE(BGUX1,U,2)
IF BGUXFID
SET BGUXFLEV=BGUXFLEV+1
SET BGUXFID(BGUXFLEV)=BGUXFID
+7 IF 'BGUXFID
Begin DoDot:2
+8 SET BGUXSBS=""
SET BGUXCFN=""
+9 FOR BGUN=1:1:BGUXFLEV
IF BGUN>1
SET BGUXSBS=BGUXSBS_","
SET BGUXCFN=BGUXCFN_"!"
SET BGUXSBS=BGUXSBS_BGUXSBS(BGUN)
SET BGUXCFN=BGUXCFN_BGUXFN(BGUN)
+10 SET BGUXNM=$PIECE(BGUX1,U)
SET BGUXTY=$PIECE(BGUX1,U,2)
SET BGUXN=$PIECE($PIECE(BGUX1,U,4),";",2)_U
IF BGUN>1
SET BGUXN=BGUXN_$SELECT(BGUXTY["W":"W",BGUXTY["C":"C",1:"M")
+11 IF BGUFATT
SET BGUXN=BGUXN_U_BGUX1
+12 IF BGUXSBS(BGUN)?." "
SET BGUXCFN="SF:"_BGUXCFN
+13 SET BGUCNT=BGUCNT+1
DO SETDATA(BGUPFX_BGUXCFN_U_BGUXNM_U_BGUXSBS_U_BGUXN,BGUCNT)
End DoDot:2
End DoDot:1
IF BGUXFLEV=1
QUIT
+14 QUIT
+15 ;
KILL ;
+1 KILL BGUCNT,BGUFILE,BGUFILE1,BGUFN,BGUFN1,BGUGNODE,BGUN,BGUN1,BGUN2,BGUNN,BGUPFX,BGUVLST,BGUVLST1,BGUX,BGUX1,BGUXCFN,BGUXFID,BGUXFLEV,BGUXFN,BGUXFN1,BGUXLFID,BGUXN,BGUXNM,BGUXSBNS,BGUXSBS,BGUXTY
+2 QUIT
