BGULIST2 ; IHS/OIT/MJL - GENERAL FILE LISTER ; [ 11/07/2007 2:26 PM ]
;;1.5;BGU;**3**;MAY 26, 2005
INIT ;EP Called by BGULIST
S U="^",BGUFILE=$G(BGUFILE),BGUIEN=$G(BGUIEN),BGUMORE=$G(BGUMORE),BGUCRFS=$G(BGUCRFS),BGUARRAY=$G(BGUARRAY),BGUSTART=$G(BGUSTART,1),BGUSCR=$G(BGUSCR),BGUTDLM=$C(175) S:BGUSCR["|" BGUSCR=$TR(BGUSCR,"|","^")
S BGUBEGIN=$G(BGUBEGIN),BGUEND=$G(BGUEND),BGUDIR=$G(BGUDIR,"F"),BGUVLST=$G(BGUVLST),BGUCNT=0,BGUICNT=0,BGUICNT1=0,BGUOFN=0,BGUSETD=0,BGUERROR=0,BGUFMCK=0,BGUERMSG="",BGUOFILE=BGUFILE
S BGULDIR=$G(BGULDIR,BGUDIR),BGUFIRST=$G(BGUFIRST),BGULAST=$G(BGULAST,"UNDEF"),BGULLEV=0,BGUMAX=$G(BGUMAX,25),BGUCNDS=$G(BGUCNDS)
I BGUCRFS'="",BGUBEGIN'="",$E(BGUEND,1,$L(BGUBEGIN))=BGUBEGIN S BGUFMCK=$L(BGUBEGIN)
S:'BGUMAX BGUMAX=25 S:BGUDIR="" BGUDIR="F" S BGUDIR1=$S(BGUDIR="F":1,1:-1)
I BGUDIR1=1,'BGUMORE,BGUIEN="" S BGUSTART=1
S:$G(BGULFILE)'=BGUFILE BGUSTART=1,BGULVLST=""
I $G(BGULCRFS)'=BGUCRFS,BGUIEN="",$G(BGULIEN)="" S BGUSTART=1
I BGUSTART D Q:BGUERROR
.S BGUGREF="",BGUGBL=$$GETGBL(BGUFILE),BGUMGBL=BGUGBL I BGUGBL="" S BGUERROR=1,BGUERMSG="Invalid File Requested!" Q
.I BGUCRFS'="" S BGUCRFS1=BGUCRFS,BGUCGBL=BGUGBL D:$E(BGUCRFS,1,3)="SC:" @($P($P(BGUCRFS,"SC:",2),"|")_U_$P(BGUCRFS,"|",2)) D:BGUCRFS1[";" Q:BGUERROR S BGUCGREF=BGUCGBL_"BGUSVSUB(1),BGUSVSUB(2),BGUSUB(1))"
..S BGUCGBL=$$GETGBL($P(BGUCRFS1,";")) I BGUCGBL="" S BGUERROR=1,BGUERMSG="Invalid Cross-reference specified -- "_$P(BGUCRFS1,";") Q
..S BGUCRFS1=$P(BGUCRFS1,";",2)
.I '$D(DT) D NOW^%DTC S DT=X K %,%I,%H
I BGUVLST'=$G(BGULVLST),BGUOFN=0 K BGUFGBL,BGUFLDS I BGUVLST'="" F BGUN=1:1:$L(BGUVLST,",") S BGUX=$P(BGUVLST,",",BGUN) D GETFLDS
I BGUCNDS'=$G(BGULCNDS) D BLDCND^BGUCND S BGUN="" F S BGUN=$O(BGUCND(BGUN)) Q:BGUN="" S BGUXX=$P(BGUCND(BGUN),U,2),BGUX=$P(BGUXX,"~",2) D GETFLDS S BGUX=$P(BGUXX,"~",3) I BGUX?1AN.AN D GETFLDS
S BGUOFN1=0 F S BGUOFN1=$O(BGULNKFD(BGUOFN1)) Q:'BGUOFN1 S BGUX=BGULNKFD(BGUOFN1),BGUOFILE=$P($P(BGUX,":",1),"F",2),BGUIVS=$P(BGUX,":",2),BGUOVS=$P(BGUX,":",3) D
.S BGUMXIV="" F BGUN1=1:1:$L(BGUIVS,"~") S BGUIV=$P(BGUIVS,"~",BGUN1) I BGUIV,BGUIV'[";",$L(BGUIV,"!")>$L(BGUMXIV,"!")!(BGUMXIV="") S BGUMXIV=BGUIV
.S:BGUMXIV'="" BGULNKFD(BGUOFN1,0)=BGUMXIV
.F BGUN1=1:1:$L(BGUOVS,"~") S BGUOV=BGUOFILE_";"_$P(BGUOVS,"~",BGUN1),BGUOV(BGUOV)=BGUOFN1
S BGUOFN1=0,BGUOLEV=1,BGULFORD="" F S:BGUOLEV=1 BGUOFN1=BGUOFN1+1,BGUOFN(BGUOLEV)=BGUOFN1,BGUTSEG="" Q:'$D(BGULNKFD(BGUOFN1)) D
.I BGUOLEV=1,","_BGULFORD_","[(","_BGUOFN1_",") Q
.S BGUX=BGULNKFD(BGUOFN(BGUOLEV)) S BGUOFILE=$P($P(BGUX,":",1),"F",2),BGUIVS=$P(BGUX,":",2) D
..S BGUINC=0 F BGUOLEV(BGUOLEV)=$G(BGUOLEV(BGUOLEV),1):1:$L(BGUIVS,"~") S BGUIV=$P(BGUIVS,"~",BGUOLEV(BGUOLEV)),BGUOVLV=$G(BGUOV(BGUIV)) I BGUOVLV D Q:BGUINC
...I $D(BGULNKFD(BGUOVLV,0)),$L(BGULNKFD(BGUOVLV,0),"!")>$L($G(BGULNKFD(BGUOFN(BGUOLEV),0)),"!") S BGULNKFD(BGUOFN(BGUOLEV),0)=BGULNKFD(BGUOVLV,0)
...I BGUOVLV>BGUOFN(BGUOLEV),","_BGULFORD_","'[(","_BGUOVLV_",") S BGUTSEG=BGUOVLV_","_BGUTSEG,BGUOLEV=BGUOLEV+1,BGUOFN(BGUOLEV)=BGUOVLV,BGUINC=1
..Q:BGUINC
..I BGUOLEV>1 S BGUOLEV=BGUOLEV-1 Q:BGUOLEV>1
..S:BGULFORD'="" BGULFORD=BGULFORD_"," S:BGUTSEG'="" BGULFORD=BGULFORD_BGUTSEG_"," S BGULFORD=BGULFORD_BGUOFN1 K BGUOLEV S BGUOLEV=1
K BGUINC,BGUOFN,BGUOLEV,BGUOV,BGUOVLV,BGUTSEG
I BGULFORD'="" S BGUOFN=0 F BGUN=1:1:$L(BGULFORD,",") S BGUOFN1=$P(BGULFORD,",",BGUN),BGUX=BGULNKFD(BGUOFN1) D GETOFLDS
K @BGUARRAY,BGUDLEV,BGUDNODE,BGUFDSBS,BGUFILE1,BGUFN1,BGUGLEV,BGUIV,BGUGNODE,BGULFORD,BGULFSBS,BGULNKFD,BGUMXIV,BGUOFILE(0),BGUOFN,BGUOFN1,BGUX1,BGUFRTN,BGUFRTN1
Q
;
GETFLDS ;
I BGUX[":" S BGUOFN=BGUOFN+1,BGULNKFD(BGUOFN)=BGUX Q
D GETDDI(BGUFILE,BGUX)
I BGUX1="",BGUX,BGUX=+BGUX S BGUSF(BGUX)=""
Q
;
GETOFLDS ;
S BGUOFILE=$P($P(BGUX,":",1),"F",2),BGUIVS=$P(BGUX,":",2),BGUOVS=$P(BGUX,":",3),BGUFRTN=$P(BGUX,":",4),BGUDNODE=$G(BGULNKFD(BGUOFN1,3))
F BGUN1=1:1:$L(BGUIVS,"~") S (BGUIV,BGUX1)=$P(BGUIVS,"~",BGUN1),BGUFILE1=BGUFILE,BGUFN1=BGUX1 S:BGUX1[";" BGUFILE1=$P(BGUX1,";",1),BGUFN1=$P(BGUX1,";",2) I $E(BGUFN1)'="""" D
.S (BGUXSBS,BGUGNODE)=""
.D GETDDI(BGUFILE1,BGUFN1) I BGUDNODE="",BGUIV=$G(BGULNKFD(BGUOFN1,0)) S BGUDNODE=$G(BGUXSBS) S:BGUDNODE="" BGUDNODE=$G(BGUGNODE) I BGUDNODE'="" S:$E(BGUDNODE,$L(BGUDNODE))="," BGUDNODE=$E(BGUDNODE,1,$L(BGUDNODE)-1) S BGULFSBS(BGUIV)=BGUDNODE
D
.I BGUDNODE="",$D(BGULNKFD(BGUOFN1,0)) S BGUDNODE=$G(BGULFSBS(BGULNKFD(BGUOFN1,0)))
.S:BGUDNODE="" BGUDNODE=0 S BGUDLEV=$L(BGUDNODE,",")*2 S:'$D(BGULNKFD(BGUOFN1,3)) BGULNKFD(BGUOFN1,3)=BGUDNODE
.I '$D(BGUOFILE(0,BGUOFILE_U_BGUIVS)) S BGUOFN=BGUOFN+1,BGUOFILE(0,BGUOFILE_U_BGUIVS)=BGUDLEV_U_BGUDNODE_U_BGUOFN,@("BGUOFILE(BGUDLEV,"_BGUDNODE_",BGUOFN)")=BGUOFILE_U_BGUIVS_U_BGUOVS_U_BGUFRTN Q
.S BGUOFILX=BGUOFILE(0,BGUOFILE_U_BGUIVS)
.S BGUXAR="BGUOFILE($P(BGUOFILX,U),"_$P(BGUOFILX,U,2)_",$P(BGUOFILX,U,3))"
.S BGUOFLX=@BGUXAR,BGUFRTN1=$P(BGUOFLX,U,4)
.S BGUFRTNS="" S:BGUFRTN1'="" BGUFRTNS=BGUFRTN1 I BGUFRTN'="" S:BGUFRTNS'="" BGUFRTNS=BGUFRTNS_ " " S BGUFRTNS=BGUFRTNS_BGUFRTN
.;S $P(@BGUXAR,U,3,4)=$P(BGUOFLX,U,3)_"~"_BGUOVS_U_$S(BGUFRTN1="":BGUFRTN,BGUFRTN="":BGUFRTN1,1:BGUFRTN1_","_BGUFRTN) K BGUOFILX,BGUOFLX
.S @BGUXAR=$P(@BGUXAR,U,1,2)_U_$P(BGUOFLX,U,3)_"~"_BGUOVS_U_BGUFRTNS K BGUFRTNS,BGUOFILX,BGUOFLX
F BGUN1=1:1:$L(BGUOVS,"~") S BGUOV=$P(BGUOVS,"~",BGUN1) D GETDDI(BGUOFILE,BGUOV) I BGUX1="",BGUOV,BGUOV=+BGUOV S BGUSF(BGUOV)=""
Q
;
; Restore all the variables previously saved during the previous run
; for a particular client's object
RESTORE ;EP Called by BGULIST
S BGUTV="" F S BGUTV=$O(^TMP("BGUSAVE",BGUID,BGUTV)) Q:BGUTV="" M @BGUTV=^TMP("BGUSAVE",BGUID,BGUTV)
S BGULVLST="",BGUN="" F S BGUN=$O(^TMP("BGULVLST",BGUID,BGUN)) Q:BGUN="" S BGULVLST=BGULVLST_^TMP("BGULVLST",BGUID,BGUN)
K ^TMP("BGUSAVE",BGUID),^TMP("BGULVLST",BGUID)
Q
;
; Save all of the variables required to preserve state
SAVE ;EP Called by BGULIST
S BGUTVS="BGUCGREF,BGUCHNG,BGUCND,BGUCMXL,BGUFGBL,BGUFLDS,BGUGBL,BGUGREF,BGUL,BGULAST,BGULCRFS,BGULCNDS,BGULDIR,BGULEV,BGULFILE,BGULFRST,BGULICNT,BGULIEN,BGULLAST,BGULLEV,BGULSIEN,BGUMGBL,BGUOFILE,BGUSF,BGUSTART,BGUSTLEV,BGUSUB,DT"
F BGUN=1:1:$L(BGUTVS,",") S BGUTV=$P(BGUTVS,",",BGUN) M:$D(@BGUTV) ^TMP("BGUSAVE",BGUID,BGUTV)=@BGUTV
F BGUN=1:1:$L(BGULVLST)\400+($L(BGULVLST)#400>0) S ^TMP("BGULVLST",BGUID,BGUN)=$E(BGULVLST,BGUN-1*400+1,BGUN*400)
K BGUTV,BGUTVS
Q
;
; Input: FileMan name Returns: Global reference
; or number
GETGBL(BGUX) ;
S:'BGUX BGUX=$O(^DIC("B",BGUX,"")) Q:BGUX="" BGUX
S BGUX=$G(^DIC(BGUX,0,"GL"))
Q BGUX
S BGUDCK=$D(@BGUGREF),BGUY=$G(^(BGUSUB(BGULEV))) Q BGUY
Q BGUY
;
SETDATA(BGUX,BGUXN,BGUXN1) ;
S ^TMP("BGULIST",BGUID,BGUXN,BGUXN1)=BGUX
Q
;
; Get the definition of a field from ^DD for a FileMan file
; BGULKUA - Pointer lookups are allowed
; BGULKU - flag indicating that if a field is a pointer type
; do the lookup -- replace the pointer value with the looked
; up value
; If a field has a -P arguement that indicates that the pointer is to
; be used (the IEN) -- the lookup should not take place.
GETDDI(BGUXFID,BGUXFN) ;
S BGUGLEV=$L(BGUXFN,"!")*2,BGUGNODE=0,BGULKU=1 I BGUXFN["-" S:BGUXFN["-P" BGULKU=0 S BGUXFN=$P(BGUXFN,"-")
I BGUXFN="*" D Q
.S BGUXFN=0 F S BGUXFN=$O(^DD(BGUFILE,BGUXFN)) Q:'BGUXFN D GCMPDDI(BGUXFID,BGUXFN)
.K BGUXCFN,BGUXFLEV,BGUXSFID
I BGUXFN'["!" S BGUX1=$G(^DD(BGUXFID,BGUXFN,0)) Q:BGUX1="" D Q
.S BGUGLEV=$L(BGUXFN,"!")*2,BGUGNODE=$P(BGUX1,U,4),BGUXN=$P(BGUGNODE,";",2),BGUGNODE=$P(BGUGNODE,";")
.I $P(BGUX1,U,2)'["C" D Q
..S:'$D(BGUFLDS(BGUXFID,BGUGNODE,"FN",BGUXN,BGUXFN)) BGUFGBL(BGUXFID,BGUGNODE)="",BGUFLDS(BGUXFID,BGUGNODE,"FN",BGUXN,BGUXFN)=$S('BGULKU:"",$P(BGUX1,U,2)["P"!($P(BGUX1,U,2)["V"):$$PTRDEF(BGUX1),1:"") Q
.D CFDEF(BGUXFN)
S BGUXFID1=BGUXFID,BGUXSBS=""
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:BGUGNODE'=" " BGUXSBS=BGUXSBS_""""_BGUGNODE_""",",BGUXFID1=+$P(BGUX1,U,2)
D:BGUX1'=""
.I $P(BGUX1,U,2)["C" D CFDEF(BGUXFN,BGUXSBS) Q
.S BGUXN=$P($P(BGUX1,U,4),";",2)
.I '$D(@("BGUFLDS("_BGUXFID_","_BGUXSBS_"""FN"",BGUXN,BGUXFN)")) D
..S @("BGUFLDS("_BGUXFID_","_BGUXSBS_"""FN"",BGUXN,BGUXFN)")=$S('BGULKU:"",$P(BGUX1,U,2)["P"!($P(BGUX1,U,2)["V"):$$PTRDEF(BGUX1),1:"")
..S @("BGUFGBL(BGUXFID,"_$E(BGUXSBS,1,$L(BGUXSBS)-1)_")")=""
I BGUX1="",BGUN2=1,'$D(BGUFLDS(0,BGUXFID,BGUXFN)) D
.S BGUX1=$G(^DD(BGUXFID,.01,0)) Q:BGUX1=""
.S BGUGNODE=$P(BGUX1,U,4),BGUXN=$P(BGUGNODE,";",2),BGUGNODE=$P(BGUGNODE,";"),BGUXSBS=$P(BGUIVS,"~")_","""_BGUGNODE_""""
.I '$D(@("BGUFLDS("_BGUXFID_","_BGUXSBS_",""FN"",BGUXN,BGUXFN)")) D
..S @("BGUFLDS("_BGUXFID_","_BGUXSBS_",""FN"",BGUXN,BGUXFN)")=$S('BGULKU:"",$P(BGUX1,U,2)["P"!($P(BGUX1,U,2)["V"):$P($$GETGBL(BGUXFID),U,2)_"\"_$$PTRDEF(BGUX1),1:"")
..S @("BGUFGBL(BGUXFID,"_BGUXSBS_")")="",BGUFLDS(0,BGUXFID,BGUXFN)=""
K BGULKU,BGUN2,BGUXFID1
Q
;
; Gets the definitions for all of the fields defined for a global
;
GCMPDDI(BGUXFID,BGUXFN) ;
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 BGUXSFID=+$P(BGUX1,U,2) S:BGUXSFID BGUXFLEV=BGUXFLEV+1,BGUXFID(BGUXFLEV)=BGUXSFID
.I 'BGUXSFID S BGUXN=$P($P(BGUX1,U,4),";",2) D
..S BGUXSBS="",BGUXCFN=""
..F BGUN2=1:1:BGUXFLEV D
...I BGUXSBS(BGUN2)'=" " S:BGUN2>1 BGUXSBS=BGUXSBS_"," S BGUXSBS=BGUXSBS_""""_BGUXSBS(BGUN2)_""""
...S:BGUN2>1 BGUXCFN=BGUXCFN_"!" S BGUXCFN=BGUXCFN_BGUXFN(BGUN2)
..I BGUXSBS(BGUXFLEV)'=" " S @("BGUFGBL(BGUXFID,"_BGUXSBS_")")="",@("BGUFLDS("_BGUXFID_","_BGUXSBS_",""FN"",BGUXN,BGUXCFN)")=$S($P(BGUX1,U,2)["P"!($P(BGUX1,U,2)["V"):$$PTRDEF(BGUX1),1:"") Q
..D:$P(BGUX1,U,2)["C" CFDEF(BGUXCFN,BGUXSBS)
Q
;
; Looks up the file lookup definition for a pointer field. Accumulates
; lookup info until field pointed to is not a pointer.
PTRDEF(BGUX) ;
Q:$P(BGUX,U,2)["V" "V"
S BGUY=""
F BGUPTRC=1:1 S:BGUPTRC>1 BGUY=BGUY_"\" S BGUY=BGUY_$P(BGUX,U,3),BGUX=+$P($P(BGUX,U,2),"P",2),BGUX=$G(^DD(BGUX,.01,0)) Q:$P(BGUX,U,2)'["P"
K BGUPTRC
Q BGUY
;
CFDEF(BGUX,BGUY) ;
S BGUGNODE=$G(^DD(BGUXFID,$P(BGUX,"!",$L(BGUX,"!")),9.01)) S:BGUGNODE="" BGUGNODE=0 S:BGUGNODE BGUGNODE=$P(BGUGNODE,";",$L(BGUGNODE,";")),BGUGNODE=$P($P(^DD($P(BGUGNODE,U),$P(BGUGNODE,U,2),0),U,4),";")
S BGUXSBS=$G(BGUY)
I BGUXSBS'="" S:$E(BGUXSBS,$L(BGUXSBS))'="," BGUXSBS=BGUXSBS_","
S BGUXSBS=BGUXSBS_BGUGNODE
S BGUXN=$P(BGUX1,U,5,999),@("BGUFGBL(BGUXFID,"_BGUXSBS_")")="",@("BGUFLDS("_BGUXFID_","_BGUXSBS_",""CF"",BGUX)")=BGUXN
Q
GETCFET ;
Q
;
GETPTR(BGUX) ;
S BGUV(BGUXFID,BGUFN,"SUB")=BGUX,BGUV(BGUXFID,BGUFN_"-P")=BGUX
Q:BGUPTR="V" $P($G(@("^"_$P(BGUX,";",2)_""""_$P(BGUX,";")_""",0)")),U,1)
S BGUYY=BGUX
F BGUIDX=1:1:$L(BGUPTR,"\") S BGUYY=$P($G(@("^"_$P(BGUPTR,"\",BGUIDX)_""""_BGUYY_""",0)")),U,1)
S:BGUYY="" BGUYY=BGUX
K BGUIDX
Q BGUYY
;
BEGIN(BGUX) ;
I BGUX="" Q ""
I BGUX=0 Q ""
I BGUX,BGUX=+BGUX Q BGUX-1
Q $E(BGUX,1,$L(BGUX)-1)_$C($A($E(BGUX,$L(BGUX)))-1)_"~"
;
END(BGUX) ;
D
.I BGUEND="" S BGUY=BGUX="" Q
.I BGUX,BGUEND,BGUX=+BGUX,BGUEND=+BGUEND S BGUY=BGUX>BGUEND Q
.S BGUY=BGUX]]BGUEND
Q BGUY
;
FIRSTSET ;
S BGUDAT=BGUTDLM_BGUSUB(1)_$C(20)_BGUDAT,BGUV(BGUFILE,.001)=BGUSUB(1),BGUDSET=BGUDSET+1 S:BGUCRFS'="" BGUV(BGUFILE,.0001)=BGUSVSUB(2)
Q
;
COUNT ;
S BGUICNT=BGUICNT+1,BGUICNT1=BGUICNT,BGUCNT=0 S:BGUDIR1<0 BGUICNT1=BGUMAX+1-BGUICNT1
Q
;
SFLDS ;
S BGUX="" F S BGUX=$O(BGUSF(BGUX)) Q:BGUX="" S BGUCNT=BGUCNT+1 D SETDATA("SF:"_BGUX_$C(25)_BGUV(BGUFILE,BGUX),BGUICNT1,BGUCNT)
Q
;
SCRN ;
X "S BGUSCRV="_BGUSCR I BGUSCRV K BGUSCRV Q
D RMV
Q
;
RMV ;
K ^TMP("BGULIST",BGUID,BGUICNT1),BGUSCRV
S BGUICNT=BGUICNT-1,BGUDSET=BGUDSET-1
Q
RMV1 ;
K ^TMP("BGULIST",BGUID,BGUICNT1,BGUCNT)
S BGUCNT=BGUCNT-1 I BGUCNT<1 S BGUCNT=0
Q
BGULIST2 ; IHS/OIT/MJL - GENERAL FILE LISTER ; [ 11/07/2007 2:26 PM ]
+1 ;;1.5;BGU;**3**;MAY 26, 2005
INIT ;EP Called by BGULIST
+1 SET U="^"
SET BGUFILE=$GET(BGUFILE)
SET BGUIEN=$GET(BGUIEN)
SET BGUMORE=$GET(BGUMORE)
SET BGUCRFS=$GET(BGUCRFS)
SET BGUARRAY=$GET(BGUARRAY)
SET BGUSTART=$GET(BGUSTART,1)
SET BGUSCR=$GET(BGUSCR)
SET BGUTDLM=$CHAR(175)
IF BGUSCR["|"
SET BGUSCR=$TRANSLATE(BGUSCR,"|","^")
+2 SET BGUBEGIN=$GET(BGUBEGIN)
SET BGUEND=$GET(BGUEND)
SET BGUDIR=$GET(BGUDIR,"F")
SET BGUVLST=$GET(BGUVLST)
SET BGUCNT=0
SET BGUICNT=0
SET BGUICNT1=0
SET BGUOFN=0
SET BGUSETD=0
SET BGUERROR=0
SET BGUFMCK=0
SET BGUERMSG=""
SET BGUOFILE=BGUFILE
+3 SET BGULDIR=$GET(BGULDIR,BGUDIR)
SET BGUFIRST=$GET(BGUFIRST)
SET BGULAST=$GET(BGULAST,"UNDEF")
SET BGULLEV=0
SET BGUMAX=$GET(BGUMAX,25)
SET BGUCNDS=$GET(BGUCNDS)
+4 IF BGUCRFS'=""
IF BGUBEGIN'=""
IF $EXTRACT(BGUEND,1,$LENGTH(BGUBEGIN))=BGUBEGIN
SET BGUFMCK=$LENGTH(BGUBEGIN)
+5 IF 'BGUMAX
SET BGUMAX=25
IF BGUDIR=""
SET BGUDIR="F"
SET BGUDIR1=$SELECT(BGUDIR="F":1,1:-1)
+6 IF BGUDIR1=1
IF 'BGUMORE
IF BGUIEN=""
SET BGUSTART=1
+7 IF $GET(BGULFILE)'=BGUFILE
SET BGUSTART=1
SET BGULVLST=""
+8 IF $GET(BGULCRFS)'=BGUCRFS
IF BGUIEN=""
IF $GET(BGULIEN)=""
SET BGUSTART=1
+9 IF BGUSTART
Begin DoDot:1
+10 SET BGUGREF=""
SET BGUGBL=$$GETGBL(BGUFILE)
SET BGUMGBL=BGUGBL
IF BGUGBL=""
SET BGUERROR=1
SET BGUERMSG="Invalid File Requested!"
QUIT
+11 IF BGUCRFS'=""
SET BGUCRFS1=BGUCRFS
SET BGUCGBL=BGUGBL
IF $EXTRACT(BGUCRFS,1,3)="SC
DO @($PIECE($PIECE(BGUCRFS,"SC:",2),"|")_U_$PIECE(BGUCRFS,"|",2))
IF BGUCRFS1[";"
Begin DoDot:2
+12 SET BGUCGBL=$$GETGBL($PIECE(BGUCRFS1,";"))
IF BGUCGBL=""
SET BGUERROR=1
SET BGUERMSG="Invalid Cross-reference specified -- "_$PIECE(BGUCRFS1,";")
QUIT
+13 SET BGUCRFS1=$PIECE(BGUCRFS1,";",2)
End DoDot:2
IF BGUERROR
QUIT
SET BGUCGREF=BGUCGBL_"BGUSVSUB(1),BGUSVSUB(2),BGUSUB(1))"
+14 IF '$DATA(DT)
DO NOW^%DTC
SET DT=X
KILL %,%I,%H
End DoDot:1
IF BGUERROR
QUIT
+15 IF BGUVLST'=$GET(BGULVLST)
IF BGUOFN=0
KILL BGUFGBL,BGUFLDS
IF BGUVLST'=""
FOR BGUN=1:1:$LENGTH(BGUVLST,",")
SET BGUX=$PIECE(BGUVLST,",",BGUN)
DO GETFLDS
+16 IF BGUCNDS'=$GET(BGULCNDS)
DO BLDCND^BGUCND
SET BGUN=""
FOR
SET BGUN=$ORDER(BGUCND(BGUN))
IF BGUN=""
QUIT
SET BGUXX=$PIECE(BGUCND(BGUN),U,2)
SET BGUX=$PIECE(BGUXX,"~",2)
DO GETFLDS
SET BGUX=$PIECE(BGUXX,"~",3)
IF BGUX?1AN.AN
DO GETFLDS
+17 SET BGUOFN1=0
FOR
SET BGUOFN1=$ORDER(BGULNKFD(BGUOFN1))
IF 'BGUOFN1
QUIT
SET BGUX=BGULNKFD(BGUOFN1)
SET BGUOFILE=$PIECE($PIECE(BGUX,":",1),"F",2)
SET BGUIVS=$PIECE(BGUX,":",2)
SET BGUOVS=$PIECE(BGUX,":",3)
Begin DoDot:1
+18 SET BGUMXIV=""
FOR BGUN1=1:1:$LENGTH(BGUIVS,"~")
SET BGUIV=$PIECE(BGUIVS,"~",BGUN1)
IF BGUIV
IF BGUIV'[";"
IF $LENGTH(BGUIV,"!")>$LENGTH(BGUMXIV,"!")!(BGUMXIV="")
SET BGUMXIV=BGUIV
+19 IF BGUMXIV'=""
SET BGULNKFD(BGUOFN1,0)=BGUMXIV
+20 FOR BGUN1=1:1:$LENGTH(BGUOVS,"~")
SET BGUOV=BGUOFILE_";"_$PIECE(BGUOVS,"~",BGUN1)
SET BGUOV(BGUOV)=BGUOFN1
End DoDot:1
+21 SET BGUOFN1=0
SET BGUOLEV=1
SET BGULFORD=""
FOR
IF BGUOLEV=1
SET BGUOFN1=BGUOFN1+1
SET BGUOFN(BGUOLEV)=BGUOFN1
SET BGUTSEG=""
IF '$DATA(BGULNKFD(BGUOFN1))
QUIT
Begin DoDot:1
+22 IF BGUOLEV=1
IF ","_BGULFORD_","[(","_BGUOFN1_",")
QUIT
+23 SET BGUX=BGULNKFD(BGUOFN(BGUOLEV))
SET BGUOFILE=$PIECE($PIECE(BGUX,":",1),"F",2)
SET BGUIVS=$PIECE(BGUX,":",2)
Begin DoDot:2
+24 SET BGUINC=0
FOR BGUOLEV(BGUOLEV)=$GET(BGUOLEV(BGUOLEV),1):1:$LENGTH(BGUIVS,"~")
SET BGUIV=$PIECE(BGUIVS,"~",BGUOLEV(BGUOLEV))
SET BGUOVLV=$GET(BGUOV(BGUIV))
IF BGUOVLV
Begin DoDot:3
+25 IF $DATA(BGULNKFD(BGUOVLV,0))
IF $LENGTH(BGULNKFD(BGUOVLV,0),"!")>$LENGTH($GET(BGULNKFD(BGUOFN(BGUOLEV),0)),"!")
SET BGULNKFD(BGUOFN(BGUOLEV),0)=BGULNKFD(BGUOVLV,0)
+26 IF BGUOVLV>BGUOFN(BGUOLEV)
IF ","_BGULFORD_","'[(","_BGUOVLV_",")
SET BGUTSEG=BGUOVLV_","_BGUTSEG
SET BGUOLEV=BGUOLEV+1
SET BGUOFN(BGUOLEV)=BGUOVLV
SET BGUINC=1
End DoDot:3
IF BGUINC
QUIT
+27 IF BGUINC
QUIT
+28 IF BGUOLEV>1
SET BGUOLEV=BGUOLEV-1
IF BGUOLEV>1
QUIT
+29 IF BGULFORD'=""
SET BGULFORD=BGULFORD_","
IF BGUTSEG'=""
SET BGULFORD=BGULFORD_BGUTSEG_","
SET BGULFORD=BGULFORD_BGUOFN1
KILL BGUOLEV
SET BGUOLEV=1
End DoDot:2
End DoDot:1
+30 KILL BGUINC,BGUOFN,BGUOLEV,BGUOV,BGUOVLV,BGUTSEG
+31 IF BGULFORD'=""
SET BGUOFN=0
FOR BGUN=1:1:$LENGTH(BGULFORD,",")
SET BGUOFN1=$PIECE(BGULFORD,",",BGUN)
SET BGUX=BGULNKFD(BGUOFN1)
DO GETOFLDS
+32 KILL @BGUARRAY,BGUDLEV,BGUDNODE,BGUFDSBS,BGUFILE1,BGUFN1,BGUGLEV,BGUIV,BGUGNODE,BGULFORD,BGULFSBS,BGULNKFD,BGUMXIV,BGUOFILE(0),BGUOFN,BGUOFN1,BGUX1,BGUFRTN,BGUFRTN1
+33 QUIT
+34 ;
GETFLDS ;
+1 IF BGUX[":"
SET BGUOFN=BGUOFN+1
SET BGULNKFD(BGUOFN)=BGUX
QUIT
+2 DO GETDDI(BGUFILE,BGUX)
+3 IF BGUX1=""
IF BGUX
IF BGUX=+BGUX
SET BGUSF(BGUX)=""
+4 QUIT
+5 ;
GETOFLDS ;
+1 SET BGUOFILE=$PIECE($PIECE(BGUX,":",1),"F",2)
SET BGUIVS=$PIECE(BGUX,":",2)
SET BGUOVS=$PIECE(BGUX,":",3)
SET BGUFRTN=$PIECE(BGUX,":",4)
SET BGUDNODE=$GET(BGULNKFD(BGUOFN1,3))
+2 FOR BGUN1=1:1:$LENGTH(BGUIVS,"~")
SET (BGUIV,BGUX1)=$PIECE(BGUIVS,"~",BGUN1)
SET BGUFILE1=BGUFILE
SET BGUFN1=BGUX1
IF BGUX1[";"
SET BGUFILE1=$PIECE(BGUX1,";",1)
SET BGUFN1=$PIECE(BGUX1,";",2)
IF $EXTRACT(BGUFN1)'=""""
Begin DoDot:1
+3 SET (BGUXSBS,BGUGNODE)=""
+4 DO GETDDI(BGUFILE1,BGUFN1)
IF BGUDNODE=""
IF BGUIV=$GET(BGULNKFD(BGUOFN1,0))
SET BGUDNODE=$GET(BGUXSBS)
IF BGUDNODE=""
SET BGUDNODE=$GET(BGUGNODE)
IF BGUDNODE'=""
IF $EXTRACT(BGUDNODE,$LENGTH(BGUDNODE))=","
SET BGUDNODE=$EXTRACT(BGUDNODE,1,$LENGTH(BGUDNODE)-1)
SET BGULFSBS(BGUIV)=BGUDNODE
End DoDot:1
+5 Begin DoDot:1
+6 IF BGUDNODE=""
IF $DATA(BGULNKFD(BGUOFN1,0))
SET BGUDNODE=$GET(BGULFSBS(BGULNKFD(BGUOFN1,0)))
+7 IF BGUDNODE=""
SET BGUDNODE=0
SET BGUDLEV=$LENGTH(BGUDNODE,",")*2
IF '$DATA(BGULNKFD(BGUOFN1,3))
SET BGULNKFD(BGUOFN1,3)=BGUDNODE
+8 IF '$DATA(BGUOFILE(0,BGUOFILE_U_BGUIVS))
SET BGUOFN=BGUOFN+1
SET BGUOFILE(0,BGUOFILE_U_BGUIVS)=BGUDLEV_U_BGUDNODE_U_BGUOFN
SET @("BGUOFILE(BGUDLEV,"_BGUDNODE_",BGUOFN)")=BGUOFILE_U_BGUIVS_U_BGUOVS_U_BGUFRTN
QUIT
+9 SET BGUOFILX=BGUOFILE(0,BGUOFILE_U_BGUIVS)
+10 SET BGUXAR="BGUOFILE($P(BGUOFILX,U),"_$PIECE(BGUOFILX,U,2)_",$P(BGUOFILX,U,3))"
+11 SET BGUOFLX=@BGUXAR
SET BGUFRTN1=$PIECE(BGUOFLX,U,4)
+12 SET BGUFRTNS=""
IF BGUFRTN1'=""
SET BGUFRTNS=BGUFRTN1
IF BGUFRTN'=""
IF BGUFRTNS'=""
SET BGUFRTNS=BGUFRTNS_