BGULIST1 ; IHS/OIT/MJL - GENERAL FILE LISTER ; [ 03/29/2006 2:28 PM ]
;;1.5;BGU;**2**;MAY 26, 2005
;
GETITEM ;
S BGUOFL=0,BGULEV=2,BGUDSET=0,BGUTVSET=0
D
.I BGUIEN'="",BGUCRFS="" S BGUICNT=1,BGUICNT1=1 D D:$D(BGUSF) SFLDS Q
..S BGUSTART=0,BGUSUB(1)=BGUIEN,BGUSUB(2)=$$BEGIN(BGUBEGIN),BGUCNT=0 F D GETITEM1 Q:BGUSUB(2)="" I $$END(BGUSUB(2)) S BGULAST="" Q
.I BGUCRFS'="" D Q
..S BGUCHNG=0,BGUSUB(1)=$S(BGULDIR=BGUDIR:BGULSIEN,BGUICNT=0:BGUFIEN,1:BGULSIEN)
..F S BGUSUB(1)=$$DOLRO(BGUCGREF,BGUDIR1),BGULSIEN=BGUSUB(1) Q:BGUSUB(1)="" D I BGUICNT#BGUMAX=0,BGUICNT Q
...D COUNT S BGULEV=2,BGUSUB(2)="" F D GETITEM1 Q:BGUSUB(2)=""
...D:$D(BGUSF) SFLDS D:BGUSCR'="" SCRN:$D(BGUV) S:BGUICNT=1 BGUFIEN=BGUSUB(1)
..I BGUSUB(1)="" S BGUCHNG=1 S:BGUDIR1<1 BGUFIEN=""
.D COUNT S BGUSUB(2)="" F D GETITEM1 Q:BGUSUB(2)=""
.I $D(BGUSF),$D(BGUV) D SFLDS
.D:BGUSCR'="" SCRN:$D(BGUV)
S:BGUDSET<0 BGUDSET=0
I BGUDSET,BGUCNDS'="",'BGUTVSET D RMV
K BGUDAT,BGUDATP,BGUDCK,BGUGOTD,BGUOFL,BGUREF,BGUSVCNT,BGUV,BGUXAR2
Q
;
; Used to be appended to GETITEM+4
; I BGUEND'="",BGUSUB(2)]]BGUEND S BGULAST="" Q
GETITEM1 ;
S BGUREF=$S(BGULEV#2:$$SETGREF(BGUGBL),1:$$SETAREF("BGUFGBL(BGUFILE,"))
S BGUSUB(BGULEV)=$$DOLRO(BGUREF)
I BGUSUB(BGULEV)="" S BGULEV=BGULEV-1 Q
S BGUREF=$$SETGREF(BGUMGBL),BGUDAT=$$GETDATA()
I BGULEV#2=0 S BGUGOTD=0 D:BGUDCK#2
.S BGUXAR="BGUFLDS(BGUFILE,"_BGUARSBS_",""FN"")" S:$D(@BGUXAR) BGUDAT=$$GETVRS(BGUFILE,BGUDAT),BGUDATP=BGUYP
.D:BGUGOTD
..S BGUSVCNT=BGUCNT,BGUCNT=BGUCNT+1 D:BGUCNT=1 FIRSTSET
..D SETDATA(BGUDAT,BGUICNT1,BGUCNT)
..I BGUDATP'="" S BGUCNT=BGUCNT+1 D SETDATA("P>"_BGUDATP,BGUICNT1,BGUCNT) S BGUDATP=""
..S BGUXAR1=BGUXAR,BGUXAR="BGUFLDS(BGUFILE,"_BGUARSBS_",""CF"")" D:$D(@BGUXAR) GETCF S BGUXAR=BGUXAR1
..I 'BGUOFL,$D(@("BGUOFILE(BGULEV,"_BGUARSBS_")")) D OFILE
..I BGUCNDS'="",BGULEV=BGUCMXL D CND^BGUCND S:BGUTV BGUTVSET=1 I 'BGUTV F D RMV1 Q:BGUCNT=BGUSVCNT!'BGUCNT
I BGUDCK>1 S BGULEV=BGULEV+1,BGUSUB(BGULEV)=$G(BGUSUB(BGULEV)) Q
Q
;
OFILE ;
S BGUOFL=1,BGULOOP=0,(BGUXAR2,BGUXRFSB)="",BGUXRSET=0
S BGUPFIL1=BGUREF,BGUSLEV1=BGULEV M BGUSVSB1=BGUSUB
F BGUN=2:1:$L(BGUARSBS,"BGUSUB") S BGUXAR2=BGUXAR2_"BGUSVSB1"_$P(BGUARSBS,"BGUSUB",BGUN)
S BGUXAR2="BGUOFILE(BGUSLEV1,"_BGUXAR2_")"
K BGUSUB
F D OFILE1 Q:'BGUXRFSB
S BGUREF=BGUPFIL1,BGULEV=BGUSLEV1
K BGUFRTN,BGULOOP,BGUSUB,BGUPFIL1,BGUSLEV1,BGUXAR1 M BGUSUB=BGUSVSB1
K BGUSVSB1,BGUSVSB2,BGUXRF,BGUXRFSB,BGUXRSET
S BGUOFL=0
Q
;
OFILE1 ;
S BGUOFN="" F S BGUOFN=$O(@BGUXAR2@(BGUOFN)) Q:BGUOFN="" D
.S BGUX=@BGUXAR2@(BGUOFN),BGUOFILE=$P(BGUX,U),BGUIVS=$P(BGUX,U,2),BGUOVS=$P(BGUX,U,3),BGUFRTN=$P(BGUX,U,4),BGUXRF=0
.F BGUN=1:1:$L(BGUIVS,"~") D Q:BGUSUB(BGUN)=""
..S BGUX=$P(BGUIVS,"~",BGUN),BGUFILE1=BGUFILE,BGUFN1=BGUX
..I BGUN=1,$E(BGUX)="""" S BGUXRF=1
..S:BGUX[";" BGUFILE1=$P(BGUX,";",1),BGUFN1=$P(BGUX,";",2)
..S BGUSUB(BGUN)=$S(BGUFN1="?":"?",$E(BGUFN1)="""":$E(BGUFN1,2,$L(BGUFN1)-1),'BGUFN1:$G(@BGUFN1),BGUX["-L":$G(BGUV(BGUFILE1,+BGUFN1)),1:$G(BGUV(BGUFILE1,BGUFN1,"SUB"),$G(BGUV(BGUFILE1,BGUFN1))))
.Q:BGUSUB(BGUN)="" S BGULEV=BGUN
.S BGUREF=$$SETAREF("BGUFGBL(BGUOFILE,"),BGUREF=$$SETGREF($$GETGBL(BGUOFILE))
.I BGUFN1="?" D Q
..S BGUSUB(BGUN)="",BGUSUB(BGUN)=$O(@BGUREF) S:'$D(BGUV(BGUOFILE,BGUOVS)) BGUV(BGUOFILE,BGUOVS)=BGUSUB(BGUN)
..S (BGUDAT,BGUV(BGUOFILE,BGUOVS,"SUB"))=BGUSUB(BGUN)
..S BGUDAT=BGUIVS_"->F"_BGUOFILE_":"_BGUASBS_$C(25)_BGUDAT,BGUCNT=BGUCNT+1
..D SETDATA(BGUDAT,BGUICNT1,BGUCNT)
.S BGUDAT=$$GETDATA()
.I BGUDCK S BGULOOP=0 D
..;I BGUDCK=10,$D(@($P(BGUXAR,",""FN""")_")")),$O(@BGUREF@($O(@BGUREF@("")),""))'="" D
..I BGUXRF D Q
...I BGUXRFSB,'$D(BGUXRFSB(BGUOFILE)) Q
...D I $D(BGUSVSB2) K BGUSUB M BGUSUB=BGUSVSB2 K BGUSVSB2
....I $D(BGUXRFSB(BGUOFILE,BGUOVS)),BGUXRFSB(BGUOFILE,BGUOVS)="" Q
....M BGUSVSB2=BGUSUB S BGUSUB(1)=$O(@BGUREF@($G(BGUXRFSB(BGUOFILE,BGUOVS))))
....I BGUSUB(1)="" S BGUXRFSB(BGUOFILE,BGUOVS)="" S:BGUXRFSB BGUXRFSB=BGUXRFSB-1 Q
....I $G(BGUXRFSB(BGUOFILE,BGUOVS))="" S BGUXRFSB=BGUXRFSB+1
....S BGUXRFSB(BGUOFILE,BGUOVS)=BGUSUB(1)
....S BGUSUB(2)="",BGUSUB(2)=$O(@BGUREF),BGUDCK=$D(@BGUREF) Q:'BGUDCK
....S BGUX=BGUARSBS,BGUARSBS="BGUSVSB2(1),0",BGUASBS=BGUASBS_",0,"_BGUXRFSB(BGUOFILE,BGUOVS)_",0",BGUDAT=BGUSUB(1)
....;S BGUX=BGUARSBS,BGUARSBS="BGUSVSB2(1),0",BGUDAT=BGUSUB(1)
....D GVSSDAT
....;S BGUARSBS=BGUX,BGUASBS=BGUSUB(1)_","_BGUSUB(2),BGUDAT=$$GETDATA()
..S BGUX=$P(BGUIVS,"~",1),BGUFILE1=BGUFILE,BGUFN1=BGUX
..S:BGUX[";" BGUFILE1=$P(BGUX,";",1),BGUFN1=$P(BGUX,";",2)
..I BGUXRFSB,'$D(BGUXRFSB(BGUFILE1,BGUFN1)) Q
..;I BGUXRFSB,$D(BGUXRFSB(BGUFILE1,BGUFN1)),BGUXRFSB(BGUFILE1,BGUFN1)="" Q
..I $D(BGUXRFSB(BGUFILE1,BGUFN1)),BGUXRFSB(BGUFILE1,BGUFN1)="" Q
..I BGUDCK=10,$D(@($P(BGUXAR,",""FN""")_")")),$O(@BGUREF@($O(@BGUREF@(""))))'="" D
...S BGUXAR=$P($Q(@($P(BGUXAR,",""FN"")")_")")),",""FN""")_",""FN"")",BGUREF=$Q(@$Q(@BGUREF))
...S BGUOLEV=BGULEV,BGUXX=$P(BGUREF,"(",2,999),BGUXX=$E(BGUXX,1,$L(BGUXX)-1) F BGULEV=1:1:$L(BGUXX,",") S BGUSUB(BGULEV)=$P(BGUXX,",",BGULEV)
...S BGUREF=$$SETAREF("BGUFGBL(BGUOFILE,"),BGUREF=$$SETGREF($$GETGBL(BGUOFILE)),BGUDAT=$$GETDATA(),BGULOOP=1
..F D Q:'BGULOOP
...D GVSSDAT
...S BGUXAR1=BGUXAR,BGUXAR="BGUFLDS(BGUOFILE,"_BGUARSBS_",""CF"")" D:$D(@BGUXAR) GETCF S BGUXAR=BGUXAR1
...Q:'BGULOOP
...S BGULOOP=0,BGULEV=BGUOLEV+1 F D Q:BGUQ
....S BGUQ=0,BGUREF=$$SETGREF($$GETGBL(BGUOFILE))
....I BGULEV#2=1 S BGUSUB(BGULEV)=$$DOLRO(BGUREF,BGUDIR1) D Q
.....I BGUSUB(BGULEV) S BGULEV=BGULEV+1,BGULOOP=1 Q
.....S BGUSUB(BGULEV)=0,BGULEV=BGULEV-1 S:BGULEV=BGUOLEV BGUQ=1 Q
....S BGUQ=1,BGUDAT=$$GETDATA(),BGULEV=BGULEV-1 Q
S:BGUXRFSB BGUXRSET=1
Q
;
GVSSDAT ;
S BGUGOTD=0,BGUXAR="BGUFLDS(BGUOFILE,"_BGUARSBS_",""FN"")"
S BGUDAT=BGUIVS_"->F"_BGUOFILE_":"_BGUASBS_$C(25)_$P($$GETVRS(BGUOFILE,BGUDAT),$C(25),2)
S:BGUYP'="" BGUDATP="P>"_BGUIVS_"->F"_BGUOFILE_":"_BGUASBS_$C(25)_$P(BGUYP,$C(25),2)
I BGUGOTD S BGUCNT=BGUCNT+1 X:BGUFRTN'="" $TR(BGUFRTN,"|"_$C(31),"^,") D SETDATA(BGUDAT,BGUICNT1,BGUCNT) I BGUYP'="" S BGUCNT=BGUCNT+1 D SETDATA(BGUDATP,BGUICNT1,BGUCNT) S BGUDATP=""
Q
;
DOLRO(BGUXREF,BGUDIRX) ;
S BGUDIRX=$G(BGUDIRX,1),BGUY=$O(@BGUXREF,BGUDIRX)
Q BGUY
;
GETDATA(BGUX) ;
I $D(BGUX) S BGUDCK=$D(@BGUREF@(BGUX)),BGUY=$G(^(BGUX)) Q BGUY
S BGUDCK=$D(@BGUREF),BGUY=$G(^(BGUSUB(BGULEV))) Q BGUY
Q BGUY
;
GETGBL(BGUX) ;
S:'BGUX BGUX=$O(^DIC("B",BGUX,"")) Q:BGUX="" BGUX
S BGUX=$G(^DIC(BGUX,0,"GL"))
Q BGUX
;
SETGREF(BGUX) ;
S BGUY="",BGUSBS="",BGUASBS=""
F BGUN=1:1:BGULEV D
.S:BGUN>1 BGUY=BGUY_",",BGUASBS=BGUASBS_"," S BGUY=BGUY_"BGUSUB("_BGUN_")",BGUASBS=BGUASBS_BGUSUB(BGUN)
.I BGUN>1 S:BGUN>2 BGUSBS=BGUSBS_"," S BGUSBS=BGUSBS_BGUSUB(BGUN)
S BGUY=BGUX_BGUY_")"
Q BGUY
;
SETAREF(BGUX) ;
S BGUY=""
F BGUN=2:2:BGULEV S:BGUN>2 BGUY=BGUY_"," S BGUY=BGUY_"BGUSUB("_BGUN_")"
S BGUARSBS=BGUY,BGUY=BGUX_BGUY_")"
Q BGUY
;
SETDATA(BGUX,BGUXN,BGUXN1) ;
S ^TMP("BGULIST",BGUID,BGUXN,BGUXN1)=BGUX
Q
;
; BGUISPTR - This is a pointer
GETVRS(BGUXFID,BGUX) ;
S BGUY="",BGUYP=""
S BGUGOTD=1,BGUXN="" F S BGUXN=$O(@BGUXAR@(BGUXN)) Q:BGUXN="" D S BGUV(BGUXFID,BGUFN)=BGUX1
.S BGUFN=$O(@BGUXAR@(BGUXN,"")),BGUPTR=@BGUXAR@(BGUXN,BGUFN),BGUISPTR=BGUPTR'=""
.I +BGUXN=BGUXN D:BGUXN S:'BGUXN BGUY=BGUX Q
..S BGUX1=$P(BGUX,U,BGUXN)
..I BGUX1'="",BGUISPTR S $P(BGUYP,U,BGUXN)=BGUX1,BGUX1=$$GETPTR(BGUX1)
..S $P(BGUY,U,BGUXN)=BGUX1
.S BGUXNE1=$P(BGUXN,"E",2),BGUXNE2=$P(BGUXNE1,",",2),BGUXNE1=+BGUXNE1,BGUX1=$E(BGUX,BGUXNE1,BGUXNE2) S:BGUISPTR BGUX1=$$GETPTR(BGUX1) S $E(BGUY,BGUXNE1,BGUXNE2)=BGUX1
S BGUY=BGUSBS_$C(25)_BGUY
S:BGUYP'="" BGUYP=BGUSBS_$C(25)_BGUYP
K BGUISPTR,BGUPTR,BGUX1,BGUXN,BGUXNE1,BGUXNE2
Q BGUY
;
GETCF ;
S X="GETCFET",@^%ZOSF("TRAP")
S BGUFN="" F S BGUFN=$O(@BGUXAR@(BGUFN)) Q:BGUFN="" D
.S BGUC=0 F BGUI=1:2:(BGULEV-1) S @("D"_BGUC)=BGUSUB(BGUI),BGUC=BGUC+1
.S DA=BGUSUB(BGUI),X="",DICMX="" X @BGUXAR@(BGUFN) S BGUV(BGUOFILE,BGUFN)=X
.S BGUCNT=BGUCNT+1
.S:'BGUOFL X="SF:"_BGUFN_$C(25)_BGUV(BGUOFILE,BGUFN)
.S:BGUOFL X=BGUIVS_"->F"_BGUOFILE_":SF:"_BGUFN_":"_BGUASBS_$C(25)_BGUV(BGUOFILE,BGUFN)
.D SETDATA(X,BGUICNT1,BGUCNT)
.F BGUI=0:1:(BGULEV/2-1) K @("D"_BGUI)
.K BGUC,BGUI,DA,DICMX,X,Y
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="" I $D(BGUV(BGUFILE,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
BGULIST1 ; IHS/OIT/MJL - GENERAL FILE LISTER ; [ 03/29/2006 2:28 PM ]
+1 ;;1.5;BGU;**2**;MAY 26, 2005
+2 ;
GETITEM ;
+1 SET BGUOFL=0
SET BGULEV=2
SET BGUDSET=0
SET BGUTVSET=0
+2 Begin DoDot:1
+3 IF BGUIEN'=""
IF BGUCRFS=""
SET BGUICNT=1
SET BGUICNT1=1
Begin DoDot:2
+4 SET BGUSTART=0
SET BGUSUB(1)=BGUIEN
SET BGUSUB(2)=$$BEGIN(BGUBEGIN)
SET BGUCNT=0
FOR
DO GETITEM1
IF BGUSUB(2)=""
QUIT
IF $$END(BGUSUB(2))
SET BGULAST=""
QUIT
End DoDot:2
IF $DATA(BGUSF)
DO SFLDS
QUIT
+5 IF BGUCRFS'=""
Begin DoDot:2
+6 SET BGUCHNG=0
SET BGUSUB(1)=$SELECT(BGULDIR=BGUDIR:BGULSIEN,BGUICNT=0:BGUFIEN,1:BGULSIEN)
+7 FOR
SET BGUSUB(1)=$$DOLRO(BGUCGREF,BGUDIR1)
SET BGULSIEN=BGUSUB(1)
IF BGUSUB(1)=""
QUIT
Begin DoDot:3
+8 DO COUNT
SET BGULEV=2
SET BGUSUB(2)=""
FOR
DO GETITEM1
IF BGUSUB(2)=""
QUIT
+9 IF $DATA(BGUSF)
DO SFLDS
IF BGUSCR'=""
IF $DATA(BGUV)
DO SCRN
IF BGUICNT=1
SET BGUFIEN=BGUSUB(1)
End DoDot:3
IF BGUICNT#BGUMAX=0
IF BGUICNT
QUIT
+10 IF BGUSUB(1)=""
SET BGUCHNG=1
IF BGUDIR1<1
SET BGUFIEN=""
End DoDot:2
QUIT
+11 DO COUNT
SET BGUSUB(2)=""
FOR
DO GETITEM1
IF BGUSUB(2)=""
QUIT
+12 IF $DATA(BGUSF)
IF $DATA(BGUV)
DO SFLDS
+13 IF BGUSCR'=""
IF $DATA(BGUV)
DO SCRN
End DoDot:1
+14 IF BGUDSET<0
SET BGUDSET=0
+15 IF BGUDSET
IF BGUCNDS'=""
IF 'BGUTVSET
DO RMV
+16 KILL BGUDAT,BGUDATP,BGUDCK,BGUGOTD,BGUOFL,BGUREF,BGUSVCNT,BGUV,BGUXAR2
+17 QUIT
+18 ;
+19 ; Used to be appended to GETITEM+4
+20 ; I BGUEND'="",BGUSUB(2)]]BGUEND S BGULAST="" Q
GETITEM1 ;
+1 SET BGUREF=$SELECT(BGULEV#2:$$SETGREF(BGUGBL),1:$$SETAREF("BGUFGBL(BGUFILE,"))
+2 SET BGUSUB(BGULEV)=$$DOLRO(BGUREF)
+3 IF BGUSUB(BGULEV)=""
SET BGULEV=BGULEV-1
QUIT
+4 SET BGUREF=$$SETGREF(BGUMGBL)
SET BGUDAT=$$GETDATA()
+5 IF BGULEV#2=0
SET BGUGOTD=0
IF BGUDCK#2
Begin DoDot:1
+6 SET BGUXAR="BGUFLDS(BGUFILE,"_BGUARSBS_",""FN"")"
IF $DATA(@BGUXAR)
SET BGUDAT=$$GETVRS(BGUFILE,BGUDAT)
SET BGUDATP=BGUYP
+7 IF BGUGOTD
Begin DoDot:2
+8 SET BGUSVCNT=BGUCNT
SET BGUCNT=BGUCNT+1
IF BGUCNT=1
DO FIRSTSET
+9 DO SETDATA(BGUDAT,BGUICNT1,BGUCNT)
+10 IF BGUDATP'=""
SET BGUCNT=BGUCNT+1
DO SETDATA("P>"_BGUDATP,BGUICNT1,BGUCNT)
SET BGUDATP=""
+11 SET BGUXAR1=BGUXAR
SET BGUXAR="BGUFLDS(BGUFILE,"_BGUARSBS_",""CF"")"
IF $DATA(@BGUXAR)
DO GETCF
SET BGUXAR=BGUXAR1
+12 IF 'BGUOFL
IF $DATA(@("BGUOFILE(BGULEV,"_BGUARSBS_")"))
DO OFILE
+13 IF BGUCNDS'=""
IF BGULEV=BGUCMXL
DO CND^BGUCND
IF BGUTV
SET BGUTVSET=1
IF 'BGUTV
FOR
DO RMV1
IF BGUCNT=BGUSVCNT!'BGUCNT
QUIT
End DoDot:2
End DoDot:1
+14 IF BGUDCK>1
SET BGULEV=BGULEV+1
SET BGUSUB(BGULEV)=$GET(BGUSUB(BGULEV))
QUIT
+15 QUIT
+16 ;
OFILE ;
+1 SET BGUOFL=1
SET BGULOOP=0
SET (BGUXAR2,BGUXRFSB)=""
SET BGUXRSET=0
+2 SET BGUPFIL1=BGUREF
SET BGUSLEV1=BGULEV
MERGE BGUSVSB1=BGUSUB
+3 FOR BGUN=2:1:$LENGTH(BGUARSBS,"BGUSUB")
SET BGUXAR2=BGUXAR2_"BGUSVSB1"_$PIECE(BGUARSBS,"BGUSUB",BGUN)
+4 SET BGUXAR2="BGUOFILE(BGUSLEV1,"_BGUXAR2_")"
+5 KILL BGUSUB
+6 FOR
DO OFILE1
IF 'BGUXRFSB
QUIT
+7 SET BGUREF=BGUPFIL1
SET BGULEV=BGUSLEV1
+8 KILL BGUFRTN,BGULOOP,BGUSUB,BGUPFIL1,BGUSLEV1,BGUXAR1
MERGE BGUSUB=BGUSVSB1
+9 KILL BGUSVSB1,BGUSVSB2,BGUXRF,BGUXRFSB,BGUXRSET
+10 SET BGUOFL=0
+11 QUIT
+12 ;
OFILE1 ;
+1 SET BGUOFN=""
FOR
SET BGUOFN=$ORDER(@BGUXAR2@(BGUOFN))
IF BGUOFN=""
QUIT
Begin DoDot:1
+2 SET BGUX=@BGUXAR2@(BGUOFN)
SET BGUOFILE=$PIECE(BGUX,U)
SET BGUIVS=$PIECE(BGUX,U,2)
SET BGUOVS=$PIECE(BGUX,U,3)
SET BGUFRTN=$PIECE(BGUX,U,4)
SET BGUXRF=0
+3 FOR BGUN=1:1:$LENGTH(BGUIVS,"~")
Begin DoDot:2
+4 SET BGUX=$PIECE(BGUIVS,"~",BGUN)
SET BGUFILE1=BGUFILE
SET BGUFN1=BGUX
+5 IF BGUN=1
IF $EXTRACT(BGUX)=""""
SET BGUXRF=1
+6 IF BGUX[";"
SET BGUFILE1=$PIECE(BGUX,";",1)
SET BGUFN1=$PIECE(BGUX,";",2)
+7 SET BGUSUB(BGUN)=$SELECT(BGUFN1="?":"?",$EXTRACT(BGUFN1)="""":$EXTRACT(BGUFN1,2,$LENGTH(BGUFN1)-1),'BGUFN1:$GET(@BGUFN1),BGUX["-L":$GET(BGUV(BGUFILE1,+BGUFN1)),1:$GET(BGUV(BGUFILE1,BGUFN1,"SUB"),$GET(BGUV(BGUFILE1,BGUFN1))))
End DoDot:2
IF BGUSUB(BGUN)=""
QUIT
+8 IF BGUSUB(BGUN)=""
QUIT
SET BGULEV=BGUN
+9 SET BGUREF=$$SETAREF("BGUFGBL(BGUOFILE,")
SET BGUREF=$$SETGREF($$GETGBL(BGUOFILE))
+10 IF BGUFN1="?"
Begin DoDot:2
+11 SET BGUSUB(BGUN)=""
SET BGUSUB(BGUN)=$ORDER(@BGUREF)
IF '$DATA(BGUV(BGUOFILE,BGUOVS))
SET BGUV(BGUOFILE,BGUOVS)=BGUSUB(BGUN)
+12 SET (BGUDAT,BGUV(BGUOFILE,BGUOVS,"SUB"))=BGUSUB(BGUN)
+13 SET BGUDAT=BGUIVS_"->F"_BGUOFILE_":"_BGUASBS_$CHAR(25)_BGUDAT
SET BGUCNT=BGUCNT+1
+14 DO SETDATA(BGUDAT,BGUICNT1,BGUCNT)
End DoDot:2
QUIT
+15 SET BGUDAT=$$GETDATA()
+16 IF BGUDCK
SET BGULOOP=0
Begin DoDot:2
+17 ;I BGUDCK=10,$D(@($P(BGUXAR,",""FN""")_")")),$O(@BGUREF@($O(@BGUREF@("")),""))'="" D
+18 IF BGUXRF
Begin DoDot:3
+19 IF BGUXRFSB
IF '$DATA(BGUXRFSB(BGUOFILE))
QUIT
+20 Begin DoDot:4
+21 IF $DATA(BGUXRFSB(BGUOFILE,BGUOVS))
IF BGUXRFSB(BGUOFILE,BGUOVS)=""
QUIT
+22 MERGE BGUSVSB2=BGUSUB
SET BGUSUB(1)=$ORDER(@BGUREF@($GET(BGUXRFSB(BGUOFILE,BGUOVS))))
+23 IF BGUSUB(1)=""
SET BGUXRFSB(BGUOFILE,BGUOVS)=""
IF BGUXRFSB
SET BGUXRFSB=BGUXRFSB-1
QUIT
+24 IF $GET(BGUXRFSB(BGUOFILE,BGUOVS))=""
SET BGUXRFSB=BGUXRFSB+1
+25 SET BGUXRFSB(BGUOFILE,BGUOVS)=BGUSUB(1)
+26 SET BGUSUB(2)=""
SET BGUSUB(2)=$ORDER(@BGUREF)
SET BGUDCK=$DATA(@BGUREF)
IF 'BGUDCK
QUIT
+27 SET BGUX=BGUARSBS
SET BGUARSBS="BGUSVSB2(1),0"
SET BGUASBS=BGUASBS_",0,"_BGUXRFSB(BGUOFILE,BGUOVS)_",0"
SET BGUDAT=BGUSUB(1)
+28 ;S BGUX=BGUARSBS,BGUARSBS="BGUSVSB2(1),0",BGUDAT=BGUSUB(1)
+29 DO GVSSDAT
+30 ;S BGUARSBS=BGUX,BGUASBS=BGUSUB(1)_","_BGUSUB(2),BGUDAT=$$GETDATA()
End DoDot:4
IF $DATA(BGUSVSB2)
KILL BGUSUB
MERGE BGUSUB=BGUSVSB2
KILL BGUSVSB2
End DoDot:3
QUIT
+31 SET BGUX=$PIECE(BGUIVS,"~",1)
SET BGUFILE1=BGUFILE
SET BGUFN1=BGUX
+32 IF BGUX[";"
SET BGUFILE1=$PIECE(BGUX,";",1)
SET BGUFN1=$PIECE(BGUX,";",2)
+33 IF BGUXRFSB
IF '$DATA(BGUXRFSB(BGUFILE1,BGUFN1))
QUIT
+34 ;I BGUXRFSB,$D(BGUXRFSB(BGUFILE1,BGUFN1)),BGUXRFSB(BGUFILE1,BGUFN1)="" Q
+35 IF $DATA(BGUXRFSB(BGUFILE1,BGUFN1))
IF BGUXRFSB(BGUFILE1,BGUFN1)=""
QUIT
+36 IF BGUDCK=10
IF $DATA(@($PIECE(BGUXAR,",""FN""")_")"))
IF $ORDER(@BGUREF@($ORDER(@BGUREF@(""))))'=""
Begin DoDot:3
+37 SET BGUXAR=$PIECE($QUERY(@($PIECE(BGUXAR,",""FN"")")_")")),",""FN""")_",""FN"")"
SET BGUREF=$QUERY(@$QUERY(@BGUREF))
+38 SET BGUOLEV=BGULEV
SET BGUXX=$PIECE(BGUREF,"(",2,999)
SET BGUXX=$EXTRACT(BGUXX,1,$LENGTH(BGUXX)-1)
FOR BGULEV=1:1:$LENGTH(BGUXX,",")
SET BGUSUB(BGULEV)=$PIECE(BGUXX,",",BGULEV)
+39 SET BGUREF=$$SETAREF("BGUFGBL(BGUOFILE,")
SET BGUREF=$$SETGREF($$GETGBL(BGUOFILE))
SET BGUDAT=$$GETDATA()
SET BGULOOP=1
End DoDot:3
+40 FOR
Begin DoDot:3
+41 DO GVSSDAT
+42 SET BGUXAR1=BGUXAR
SET BGUXAR="BGUFLDS(BGUOFILE,"_BGUARSBS_",""CF"")"
IF $DATA(@BGUXAR)
DO GETCF
SET BGUXAR=BGUXAR1
+43 IF 'BGULOOP
QUIT
+44 SET BGULOOP=0
SET BGULEV=BGUOLEV+1
FOR
Begin DoDot:4
+45 SET BGUQ=0
SET BGUREF=$$SETGREF($$GETGBL(BGUOFILE))
+46 IF BGULEV#2=1
SET BGUSUB(BGULEV)=$$DOLRO(BGUREF,BGUDIR1)
Begin DoDot:5
+47 IF BGUSUB(BGULEV)
SET BGULEV=BGULEV+1
SET BGULOOP=1
QUIT
+48 SET BGUSUB(BGULEV)=0
SET BGULEV=BGULEV-1
IF BGULEV=BGUOLEV
SET BGUQ=1
QUIT
End DoDot:5
QUIT
+49 SET BGUQ=1
SET BGUDAT=$$GETDATA()
SET BGULEV=BGULEV-1
QUIT
End DoDot:4
IF BGUQ
QUIT
End DoDot:3
IF 'BGULOOP
QUIT
End DoDot:2
End DoDot:1
+50 IF BGUXRFSB
SET BGUXRSET=1
+51 QUIT
+52 ;
GVSSDAT ;
+1 SET BGUGOTD=0
SET BGUXAR="BGUFLDS(BGUOFILE,"_BGUARSBS_",""FN"")"
+2 SET BGUDAT=BGUIVS_"->F"_BGUOFILE_":"_BGUASBS_$CHAR(25)_$PIECE($$GETVRS(BGUOFILE,BGUDAT),$CHAR(25),2)
+3 IF BGUYP'=""
SET BGUDATP="P>"_BGUIVS_"->F"_BGUOFILE_":"_BGUASBS_$CHAR(25)_$PIECE(BGUYP,$CHAR(25),2)
+4 IF BGUGOTD
SET BGUCNT=BGUCNT+1
IF BGUFRTN'=""
XECUTE $TRANSLATE(BGUFRTN,"|"_$CHAR(31),"^,")
DO SETDATA(BGUDAT,BGUICNT1,BGUCNT)
IF BGUYP'=""
SET BGUCNT=BGUCNT+1
DO SETDATA(BGUDATP,BGUICNT1,BGUCNT)
SET BGUDATP=""
+5 QUIT
+6 ;
DOLRO(BGUXREF,BGUDIRX) ;
+1 SET BGUDIRX=$GET(BGUDIRX,1)
SET BGUY=$ORDER(@BGUXREF,BGUDIRX)
+2 QUIT BGUY
+3 ;
GETDATA(BGUX) ;
+1 IF $DATA(BGUX)
SET BGUDCK=$DATA(@BGUREF@(BGUX))
SET BGUY=$GET(^(BGUX))
QUIT BGUY
+2 SET BGUDCK=$DATA(@BGUREF)
SET BGUY=$GET(^(BGUSUB(BGULEV)))
QUIT BGUY
+3 QUIT BGUY
+4 ;
GETGBL(BGUX) ;
+1 IF 'BGUX
SET BGUX=$ORDER(^DIC("B",BGUX,""))
IF BGUX=""
QUIT BGUX
+2 SET BGUX=$GET(^DIC(BGUX,0,"GL"))
+3 QUIT BGUX
+4 ;
SETGREF(BGUX) ;
+1 SET BGUY=""
SET BGUSBS=""
SET BGUASBS=""
+2 FOR BGUN=1:1:BGULEV
Begin DoDot:1
+3 IF BGUN>1
SET BGUY=BGUY_","
SET BGUASBS=BGUASBS_","
SET BGUY=BGUY_"BGUSUB("_BGUN_")"
SET BGUASBS=BGUASBS_BGUSUB(BGUN)
+4 IF BGUN>1
IF BGUN>2
SET BGUSBS=BGUSBS_","
SET BGUSBS=BGUSBS_BGUSUB(BGUN)
End DoDot:1
+5 SET BGUY=BGUX_BGUY_")"
+6 QUIT BGUY
+7 ;
SETAREF(BGUX) ;
+1 SET BGUY=""
+2 FOR BGUN=2:2:BGULEV
IF BGUN>2
SET BGUY=BGUY_","
SET BGUY=BGUY_"BGUSUB("_BGUN_")"
+3 SET BGUARSBS=BGUY
SET BGUY=BGUX_BGUY_")"
+4 QUIT BGUY
+5 ;
SETDATA(BGUX,BGUXN,BGUXN1) ;
+1 SET ^TMP("BGULIST",BGUID,BGUXN,BGUXN1)=BGUX
+2 QUIT
+3 ;
+4 ; BGUISPTR - This is a pointer
GETVRS(BGUXFID,BGUX) ;
+1 SET BGUY=""
SET BGUYP=""
+2 SET BGUGOTD=1
SET BGUXN=""
FOR
SET BGUXN=$ORDER(@BGUXAR@(BGUXN))
IF BGUXN=""
QUIT
Begin DoDot:1
+3 SET BGUFN=$ORDER(@BGUXAR@(BGUXN,""))
SET BGUPTR=@BGUXAR@(BGUXN,BGUFN)
SET BGUISPTR=BGUPTR'=""
+4 IF +BGUXN=BGUXN
IF BGUXN
Begin DoDot:2
+5 SET BGUX1=$PIECE(BGUX,U,BGUXN)
+6 IF BGUX1'=""
IF BGUISPTR
SET $PIECE(BGUYP,U,BGUXN)=BGUX1
SET BGUX1=$$GETPTR(BGUX1)
+7 SET $PIECE(BGUY,U,BGUXN)=BGUX1
End DoDot:2
IF 'BGUXN
SET BGUY=BGUX
QUIT
+8 SET BGUXNE1=$PIECE(BGUXN,"E",2)
SET BGUXNE2=$PIECE(BGUXNE1,",",2)
SET BGUXNE1=+BGUXNE1
SET BGUX1=$EXTRACT(BGUX,BGUXNE1,BGUXNE2)
IF BGUISPTR
SET BGUX1=$$GETPTR(BGUX1)
SET $EXTRACT(BGUY,BGUXNE1,BGUXNE2)=BGUX1
End DoDot:1
SET BGUV(BGUXFID,BGUFN)=BGUX1
+9 SET BGUY=BGUSBS_$CHAR(25)_BGUY
+10 IF BGUYP'=""
SET BGUYP=BGUSBS_$CHAR(25)_BGUYP
+11 KILL BGUISPTR,BGUPTR,BGUX1,BGUXN,BGUXNE1,BGUXNE2
+12 QUIT BGUY
+13 ;
GETCF ;
+1 SET X="GETCFET"
SET @^%ZOSF("TRAP")
+2 SET BGUFN=""
FOR
SET BGUFN=$ORDER(@BGUXAR@(BGUFN))
IF BGUFN=""
QUIT
Begin DoDot:1
+3 SET BGUC=0
FOR BGUI=1:2:(BGULEV-1)
SET @("D"_BGUC)=BGUSUB(BGUI)
SET BGUC=BGUC+1
+4 SET DA=BGUSUB(BGUI)
SET X=""
SET DICMX=""
XECUTE @BGUXAR@(BGUFN)
SET BGUV(BGUOFILE,BGUFN)=X
+5 SET BGUCNT=BGUCNT+1
+6 IF 'BGUOFL
SET X="SF:"_BGUFN_$CHAR(25)_BGUV(BGUOFILE,BGUFN)
+7 IF BGUOFL
SET X=BGUIVS_"->F"_BGUOFILE_":SF:"_BGUFN_":"_BGUASBS_$CHAR(25)_BGUV(BGUOFILE,BGUFN)
+8 DO SETDATA(X,BGUICNT1,BGUCNT)
+9 FOR BGUI=0:1:(BGULEV/2-1)
KILL @("D"_BGUI)
+10 KILL BGUC,BGUI,DA,DICMX,X,Y
End DoDot:1
GETCFET ;
+1 QUIT
+2 ;
GETPTR(BGUX) ;
+1 SET BGUV(BGUXFID,BGUFN,"SUB")=BGUX
SET BGUV(BGUXFID,BGUFN_"-P")=BGUX
+2 IF BGUPTR="V"
QUIT $PIECE($GET(@("^"_$PIECE(BGUX,";",2)_""""_$PIECE(BGUX,";")_""",0)")),U,1)
+3 SET BGUYY=BGUX
+4 FOR BGUIDX=1:1:$LENGTH(BGUPTR,"\")
SET BGUYY=$PIECE($GET(@("^"_$PIECE(BGUPTR,"\",BGUIDX)_""""_BGUYY_""",0)")),U,1)
+5 IF BGUYY=""
SET BGUYY=BGUX
+6 KILL BGUIDX
+7 QUIT BGUYY
+8 ;
BEGIN(BGUX) ;
+1 IF BGUX=""
QUIT ""
+2 IF BGUX=0
QUIT ""
+3 IF BGUX
IF BGUX=+BGUX
QUIT BGUX-1
+4 QUIT $EXTRACT(BGUX,1,$LENGTH(BGUX)-1)_$CHAR($ASCII($EXTRACT(BGUX,$LENGTH(BGUX)))-1)_"~"
+5 ;
END(BGUX) ;
+1 Begin DoDot:1
+2 IF BGUEND=""
SET BGUY=BGUX=""
QUIT
+3 IF BGUX
IF BGUEND
IF BGUX=+BGUX
IF BGUEND=+BGUEND
SET BGUY=BGUX>BGUEND
QUIT
+4 SET BGUY=BGUX]]BGUEND
End DoDot:1
+5 QUIT BGUY
+6 ;
FIRSTSET ;
+1 SET BGUDAT=BGUTDLM_BGUSUB(1)_$CHAR(20)_BGUDAT
SET BGUV(BGUFILE,.001)=BGUSUB(1)
SET BGUDSET=BGUDSET+1
IF BGUCRFS'=""
SET BGUV(BGUFILE,.0001)=BGUSVSUB(2)
+2 QUIT
+3 ;
COUNT ;
+1 SET BGUICNT=BGUICNT+1
SET BGUICNT1=BGUICNT
SET BGUCNT=0
IF BGUDIR1<0
SET BGUICNT1=BGUMAX+1-BGUICNT1
+2 QUIT
+3 ;
SFLDS ;
+1 SET BGUX=""
FOR
SET BGUX=$ORDER(BGUSF(BGUX))
IF BGUX=""
QUIT
IF $DATA(BGUV(BGUFILE,BGUX))
SET BGUCNT=BGUCNT+1
DO SETDATA("SF:"_BGUX_$CHAR(25)_BGUV(BGUFILE,BGUX),BGUICNT1,BGUCNT)
+2 QUIT
+3 ;
SCRN ;
+1 XECUTE "S BGUSCRV="_BGUSCR
IF BGUSCRV
KILL BGUSCRV
QUIT
+2 DO RMV
+3 QUIT
+4 ;
RMV ;
+1 KILL ^TMP("BGULIST",BGUID,BGUICNT1),BGUSCRV
+2 SET BGUICNT=BGUICNT-1
SET BGUDSET=BGUDSET-1
+3 QUIT
RMV1 ;
+1 KILL ^TMP("BGULIST",BGUID,BGUICNT1,BGUCNT)
+2 SET BGUCNT=BGUCNT-1
IF BGUCNT<1
SET BGUCNT=0
+3 QUIT
