BGULIST ; IHS/OIT/MJL - GENERAL FILE LISTER ;
;;1.5;BGU;;MAY 26, 2005
;
EN(BGUARRAY,BGUFILE,BGUIEN,BGUMORE,BGUCRFS,BGUMAX,BGUBEGIN,BGUEND,BGUVLST,BGUDIR,BGUSCR,BGUID,BGUCNDS) ;PEP FROM REMOTE PROCEDURE BGU GENLIST
;;1.102;BGU;;JUL 23, 2001
;
; BGUARRAY - The array where the data is returned - ^TMP(I/P address
; - of the client)
; BGUFILE - Primary file providing the data e.g. 2 for ^DPT
; - can be the file name or number e.g. VA PATIENT or 2
; BGUIEN - Internal Entry Number - If this is set fields specific only
; to this record are returned.
; If it is null then program is in list mode.
; BGUMORE - Flag is set on (=1) if you want the program to start from
; where it left off on the previous call. If this flag
; isn't set then the program will start at the beginning
; determined by the value of BGUBEGIN.
; BGUCRFS - The cross-reference that is used to access the main file
; (or Lookup routine i.e. SC:TAG|ROUTINE)
; BGUMAX - The number of records to return on a call (default = 25)
; BGUBEGIN - The starting position in the cross-reference file if one
; is specified, otherwise the starting point in the main
; file. This parameter is only used when in list mode.
; BGUEND - The opposite of BGUBEGIN.
; (BGUBEGIN and BGUEND are used inclusively)
; BGUVLST - The variable list - a list of fileman field numbers
; - separated by commas. If a field is from the primary file
; just the field number is entered. If a field was returned
; by a lookup into another file then the field number is
; prefixed with the file number and a semicolan, e.g. 60:.01
; BGUDIR - Direction the program is traversing through the file F for
; forward and B for backward (default = F)
; BGUSCR - Mumps executable code for screening valid data. If a
; screen is defined only data that passes the screen is
; returned.
; BGUID - Identification parameter - the I/P address plus time
; including seconds
; BGUCNDS - English like condition for screening data eg.:
; SEX .EQ. "M" AND AGE > 40
;
CTL ;
S XWBWRAP=1,BGUID=$G(BGUID,$J) S:BGUID="" BGUID=$J ;S BGUARRAY="^TMP(""BGULIST"","_$S(BGUID=+BGUID:BGUID,1:""""_BGUID_"""")_")"
S BGUARRAY=$NA(@"^TMP(""BGULIST"",BGUID)")
D
.I $D(^TMP("BGUSAVE",BGUID)) D RESTORE^BGULIST2 Q
.K BGULAST S BGUSTART=1
I 'BGUFILE,BGUFILE'="" S BGUFILE=$$GETFID(BGUFILE) I BGUFILE="" S BGUERMSG="Invalid File Requested!" D ERROR,KILL Q
D KILL:$G(BGULFILE)'=BGUFILE,KILL1,INIT^BGULIST2
I BGUERROR D ERROR,KILL Q
D
.I BGULAST="",BGULDIR=BGUDIR Q:BGUMORE Q:BGUDIR="B"
.I BGULAST="UNDEF" Q:BGUDIR="B" S BGULAST=""
.I BGUIEN=""!(BGUCRFS'="") D Q
..I '$D(BGUDRIVR) D LIST Q
..S BGUGBL=BGUMGBL,BGULEV=1,BGUCRFS="",BGUMAX=9999999,(BGUCRFS,BGUBEGIN,BGUEND)="",BGUDIR1=1,BGUDIR="F" D @BGUDRIVR
.D
..I 'BGUSTART,$G(BGULIEN)="" S BGULFRST=BGUFIRST,BGULLAST=BGULAST D FIELDS S BGUFIRST=BGULFRST,BGULAST=BGULLAST Q
..D ^BGULIST1
I BGULAST="",'BGUICNT S BGUFIRST="",BGUFIEN=""
S BGULDIR=BGUDIR,BGULFILE=BGUFILE,BGULVLST=BGUVLST,BGULCRFS=BGUCRFS,BGULIEN=BGUIEN,BGULCNDS=BGUCNDS
D:BGUICNT
.S BGUDAT=BGUICNT
.I BGUIEN="",BGULAST'="",'$$END($$DOLRO(BGUSTLEV,BGUDIR1)) S BGUDAT=BGUDAT_U_1
.D SETDATA(BGUDAT,0,0)
D SAVE^BGULIST2,KILL
Q
;
; Returns a list of records - invoked only if BGUIEN is null
LIST ;
D
.I BGUSTART S BGUSTLEV=1,BGUCHNG=1 I '$D(BGUDRIVR) S:BGUCRFS'="" BGUSTLEV=2,BGUSUB(1)=BGUCRFS1,BGUGBL=BGUCGBL S BGUSUB(BGUSTLEV)=$S(BGUDIR1=1:$$BEGIN(BGUBEGIN),BGULDIR'=BGUDIR:BGUFIRST,1:BGUEND),BGUSTART=0,(BGUFIEN,BGULSIEN)="" Q
.S BGUSUB(BGUSTLEV)=$S(BGULDIR=BGUDIR:BGULAST,1:BGUFIRST) I BGUCHNG,BGULDIR'=BGUDIR,BGUFIRST'="",BGUCRFS'="",BGUVLST'="" S BGUCHNG=0
S (BGUFSET,BGULICNT)=0 F D Q:BGUSUB(BGUSTLEV)=""!(BGUICNT#BGUMAX=0&BGUICNT)
.I BGUICNT,'BGUDSET S:BGULICNT<BGUICNT BGUICNT=BGUICNT-1
.I BGUICNT,'BGUFSET S BGUFIRST=BGUSUB(BGUSTLEV),BGUFSET=1
.S BGUDSET=0,BGULEV=BGUSTLEV,BGULICNT=BGUICNT S:BGUCHNG BGUSUB(BGUSTLEV)=$$DOLRO(BGUSTLEV,BGUDIR1) I BGUSUB(BGUSTLEV)="" S BGULAST="" Q
.I $S(BGUDIR1=1:BGUEND'="",1:BGUBEGIN'=""),$$END(BGUSUB(BGUSTLEV)) S BGUSUB(BGUSTLEV)="",BGULAST="" Q
.I BGUFMCK,$E(BGUSUB(BGUSTLEV),1,BGUFMCK)'=BGUBEGIN Q
.I BGUVLST="" D Q
..I BGUCRFS="" S BGUDAT=$$GETDATA(0) D Q
...I BGUDCK#2 D COUNT,SETDATA($C(175)_BGUSUB(BGULEV)_$C(20)_"0"_$C(25)_BGUDAT,BGUICNT1,BGUCNT) Q
..S BGUTIEN=$O(@BGUGREF@("")),BGUDAT=$$GETDATA(BGUTIEN) I BGUDCK#2 D COUNT,SETDATA($C(175)_BGUTIEN_$C(20)_"0"_$C(25)_BGUDAT,BGUICNT1,BGUCNT) Q
.D FIELDS
S BGULAST=BGUSUB(BGUSTLEV)
Q
;
FIELDS ;EP GENERAL CALL FROM BPC,BGU NAMESPACE
S BGUPFILE=BGUGREF,BGUSLEV=BGULEV,BGUN=""
M BGUSVSUB=BGUSUB
D ^BGULIST1
S BGUGREF=BGUPFILE,BGULEV=BGUSLEV
K BGUPFILE,BGUSLEV,BGUSUB
M BGUSUB=BGUSVSUB
K BGUSVSUB
Q
;
DOLRO(BGUX,BGUDIRX) ;INTERNAL EP
S:BGULLEV'=BGUX BGUGREF=$$SETGREF(BGUGBL),BGULLEV=BGUX
S BGUDIRX=$G(BGUDIRX,1),BGUY=$O(@BGUGREF,BGUDIRX)
Q BGUY
;
SETGREF(BGUX) ;INTERNAL EP
S BGUY=""
F BGUN=1:1:BGULEV S:BGUN>1 BGUY=BGUY_"," S BGUY=BGUY_"BGUSUB("_BGUN_")"
S BGUY=BGUX_BGUY_")"
Q BGUY
;
GETDATA(BGUX) ;INTERNAL EP
I $D(BGUX) S BGUDCK=$D(@BGUGREF@(BGUX)),BGUY=$G(^(BGUX)) Q BGUY
S BGUDCK=$D(@BGUGREF),BGUY=$G(^(BGUSUB(BGULEV))) Q BGUY
Q BGUY
;
SETDATA(BGUX,BGUXN,BGUXN1) ;INTERNAL EP
S ^TMP("BGULIST",BGUID,BGUXN,BGUXN1)=BGUX
Q
;
BEGIN(BGUX) ;INTERNAL EP
Q:BGUX="" ""
Q:BGUX=0 ""
I BGUX,BGUX=+BGUX Q BGUX-1
Q $E(BGUX,1,$L(BGUX)-1)_$C($A($E(BGUX,$L(BGUX)))-1)_"~"
;
END(BGUX) ;INTERNAL EP
D
.I BGUDIR1=1 D Q
..I BGUEND="" S BGUY=BGUX="" Q
..I BGUX,BGUEND,BGUX=+BGUX,BGUEND=+BGUEND S BGUY=BGUX>BGUEND Q
..S BGUY=BGUX]]BGUEND
.I BGUX="" S BGUY=1 Q
.I BGUX,BGUBEGIN,BGUX=+BGUX,BGUBEGIN=+BGUBEGIN S BGUY=BGUX<BGUBEGIN Q
.S BGUY=BGUBEGIN]]BGUX
Q BGUY
;
; Input: FileMan name Returns: FileMan file number
GETFID(BGUX) ;INTERNAL EP
S:'BGUX BGUX=$O(^DIC("B",BGUX,"")) Q:BGUX="" ""
I '$D(^DIC(BGUX)) Q ""
Q BGUX
;
COUNT ;
S BGUICNT=BGUICNT+1,BGUICNT1=BGUICNT,BGUCNT=1 S:BGUDIR1<0 BGUICNT1=BGUMAX+1-BGUICNT1
Q
;
ERROR ;
D SETDATA(-1,0,0),SETDATA(BGUERMSG,0,1)
Q
;
KILL1 ;
K BGUARSBS,BGUASBS,BGUCNT,BGUDAT,BGUDATP,BGUDCK,BGUDIR1,BGUDIRX,BGUDNODE,BGUDSET,BGUFILE1,BGUFN,BGUFN1,BGUFSET,BGUGLEV,BGUGNODE,BGUGOTD,BGUICNT,BGUICNT1,BGUIDX,BGULFRST,BGULICNT,BGULIEN,BGULLAST,BGULLEV,BGUN,BGUOFL
K BGUOFN,BGUPFIL1,BGUPFILE,BGULKU,BGULKUA,BGUREF,BGUSBS,BGUSETD,BGUSLEV,BGUSLEV1,BGUTDLM,BGUTVSET,BGUV,BGUX,BGUX1,BGUXAR,BGUXFN1,BGUXLFID,BGUXN,BGUXN1,BGUXNE1,BGUXNE2,BGUXSBNS,BGUXSBS,BGUY,BGUYP
Q
;
KILL ;
K BGUDRIVR,BGUDRVRR,BGUARSBS,BGUASBS,BGUCGBL,BGUCGREF,BGUCHNG,BGUCNT,BGUCRFS1,BGUDAT,BGUDATP,BGUDCK,BGUDIR1,BGUDIRX,BGUDSET,BGUERMSG,BGUERROR,BGUFGBL,BGUFIEN,BGUFILE1,BGUFIRST,BGUFLDS,BGUFMCK,BGUFN,BGUFN1,BGUFSET,BGUGBL,BGUGNODE
K BGUGOTD,BGUGREF,BGUICNT,BGUICNT1,BGUIDX,BGUIVS,BGULAST,BGULCNDS,BGULCRFS,BGULDIR,BGULEV,BGULFILE,BGULICNT,BGULIEN,BGULKU,BGULKUA,BGULLEV,BGULSIEN,BGULVLST,BGUMGBL,BGUN,BGUN1,BGUN2,BGUOFILE,BGUOFL,BGUOFN,BGUOLEV,BGUOVS
K BGUPFIL1,BGUPFILE,BGUPTR,BGUSBS,BGUSETD,BGUSF,BGUSLEV,BGUSLEV1,BGUSTART,BGUSTLEV,BGUSUB,BGUSVSB1,BGUSVSUB,BGUTDLM,BGUTIEN,BGUTNODE,BGUTNOLV,BGUTVSET,BGUV,BGUX,BGUX1,BGUXAR,BGUXFN1,BGUXN,BGUXN1,BGUXSBS,BGUXX,BGUY,BGUYP
K BGUYY
D:$G(BGUCNDS)'="" KILL^BGUCND
Q
BGULIST ; IHS/OIT/MJL - GENERAL FILE LISTER ;
+1 ;;1.5;BGU;;MAY 26, 2005
+2 ;
EN(BGUARRAY,BGUFILE,BGUIEN,BGUMORE,BGUCRFS,BGUMAX,BGUBEGIN,BGUEND,BGUVLST,BGUDIR,BGUSCR,BGUID,BGUCNDS) ;PEP FROM REMOTE PROCEDURE BGU GENLIST
+1 ;;1.102;BGU;;JUL 23, 2001
+2 ;
+3 ; BGUARRAY - The array where the data is returned - ^TMP(I/P address
+4 ; - of the client)
+5 ; BGUFILE - Primary file providing the data e.g. 2 for ^DPT
+6 ; - can be the file name or number e.g. VA PATIENT or 2
+7 ; BGUIEN - Internal Entry Number - If this is set fields specific only
+8 ; to this record are returned.
+9 ; If it is null then program is in list mode.
+10 ; BGUMORE - Flag is set on (=1) if you want the program to start from
+11 ; where it left off on the previous call. If this flag
+12 ; isn't set then the program will start at the beginning
+13 ; determined by the value of BGUBEGIN.
+14 ; BGUCRFS - The cross-reference that is used to access the main file
+15 ; (or Lookup routine i.e. SC:TAG|ROUTINE)
+16 ; BGUMAX - The number of records to return on a call (default = 25)
+17 ; BGUBEGIN - The starting position in the cross-reference file if one
+18 ; is specified, otherwise the starting point in the main
+19 ; file. This parameter is only used when in list mode.
+20 ; BGUEND - The opposite of BGUBEGIN.
+21 ; (BGUBEGIN and BGUEND are used inclusively)
+22 ; BGUVLST - The variable list - a list of fileman field numbers
+23 ; - separated by commas. If a field is from the primary file
+24 ; just the field number is entered. If a field was returned
+25 ; by a lookup into another file then the field number is
+26 ; prefixed with the file number and a semicolan, e.g. 60:.01
+27 ; BGUDIR - Direction the program is traversing through the file F for
+28 ; forward and B for backward (default = F)
+29 ; BGUSCR - Mumps executable code for screening valid data. If a
+30 ; screen is defined only data that passes the screen is
+31 ; returned.
+32 ; BGUID - Identification parameter - the I/P address plus time
+33 ; including seconds
+34 ; BGUCNDS - English like condition for screening data eg.:
+35 ; SEX .EQ. "M" AND AGE > 40
+36 ;
CTL ;
+1 ;S BGUARRAY="^TMP(""BGULIST"","_$S(BGUID=+BGUID:BGUID,1:""""_BGUID_"""")_")"
SET XWBWRAP=1
SET BGUID=$GET(BGUID,$JOB)
IF BGUID=""
SET BGUID=$JOB
+2 SET BGUARRAY=$NAME(@"^TMP(""BGULIST"",BGUID)")
+3 Begin DoDot:1
+4 IF $DATA(^TMP("BGUSAVE",BGUID))
DO RESTORE^BGULIST2
QUIT
+5 KILL BGULAST
SET BGUSTART=1
End DoDot:1
+6 IF 'BGUFILE
IF BGUFILE'=""
SET BGUFILE=$$GETFID(BGUFILE)
IF BGUFILE=""
SET BGUERMSG="Invalid File Requested!"
DO ERROR
DO KILL
QUIT
+7 IF $GET(BGULFILE)'=BGUFILE
DO KILL
DO KILL1
DO INIT^BGULIST2
+8 IF BGUERROR
DO ERROR
DO KILL
QUIT
+9 Begin DoDot:1
+10 IF BGULAST=""
IF BGULDIR=BGUDIR
IF BGUMORE
QUIT
IF BGUDIR="B"
QUIT
+11 IF BGULAST="UNDEF"
IF BGUDIR="B"
QUIT
SET BGULAST=""
+12 IF BGUIEN=""!(BGUCRFS'="")
Begin DoDot:2
+13 IF '$DATA(BGUDRIVR)
DO LIST
QUIT
+14 SET BGUGBL=BGUMGBL
SET BGULEV=1
SET BGUCRFS=""
SET BGUMAX=9999999
SET (BGUCRFS,BGUBEGIN,BGUEND)=""
SET BGUDIR1=1
SET BGUDIR="F"
DO @BGUDRIVR
End DoDot:2
QUIT
+15 Begin DoDot:2
+16 IF 'BGUSTART
IF $GET(BGULIEN)=""
SET BGULFRST=BGUFIRST
SET BGULLAST=BGULAST
DO FIELDS
SET BGUFIRST=BGULFRST
SET BGULAST=BGULLAST
QUIT
+17 DO ^BGULIST1
End DoDot:2
End DoDot:1
+18 IF BGULAST=""
IF 'BGUICNT
SET BGUFIRST=""
SET BGUFIEN=""
+19 SET BGULDIR=BGUDIR
SET BGULFILE=BGUFILE
SET BGULVLST=BGUVLST
SET BGULCRFS=BGUCRFS
SET BGULIEN=BGUIEN
SET BGULCNDS=BGUCNDS
+20 IF BGUICNT
Begin DoDot:1
+21 SET BGUDAT=BGUICNT
+22 IF BGUIEN=""
IF BGULAST'=""
IF '$$END($$DOLRO(BGUSTLEV,BGUDIR1))
SET BGUDAT=BGUDAT_U_1
+23 DO SETDATA(BGUDAT,0,0)
End DoDot:1
+24 DO SAVE^BGULIST2
DO KILL
+25 QUIT
+26 ;
+27 ; Returns a list of records - invoked only if BGUIEN is null
LIST ;
+1 Begin DoDot:1
+2 IF BGUSTART
SET BGUSTLEV=1
SET BGUCHNG=1
IF '$DATA(BGUDRIVR)
IF BGUCRFS'=""
SET BGUSTLEV=2
SET BGUSUB(1)=BGUCRFS1
SET BGUGBL=BGUCGBL
SET BGUSUB(BGUSTLEV)=$SELECT(BGUDIR1=1:$$BEGIN(BGUBEGIN),BGULDIR'=BGUDIR:BGUFIRST,1:BGUEND)
SET BGUSTART=0
SET (BGUFIEN,BGULSIEN)=""
QUIT
+3 SET BGUSUB(BGUSTLEV)=$SELECT(BGULDIR=BGUDIR:BGULAST,1:BGUFIRST)
IF BGUCHNG
IF BGULDIR'=BGUDIR
IF BGUFIRST'=""
IF BGUCRFS'=""
IF BGUVLST'=""
SET BGUCHNG=0
End DoDot:1
+4 SET (BGUFSET,BGULICNT)=0
FOR
Begin DoDot:1
+5 IF BGUICNT
IF 'BGUDSET
IF BGULICNT<BGUICNT
SET BGUICNT=BGUICNT-1
+6 IF BGUICNT
IF 'BGUFSET
SET BGUFIRST=BGUSUB(BGUSTLEV)
SET BGUFSET=1
+7 SET BGUDSET=0
SET BGULEV=BGUSTLEV
SET BGULICNT=BGUICNT
IF BGUCHNG
SET BGUSUB(BGUSTLEV)=$$DOLRO(BGUSTLEV,BGUDIR1)
IF BGUSUB(BGUSTLEV)=""
SET BGULAST=""
QUIT
+8 IF $SELECT(BGUDIR1=1:BGUEND'="",1:BGUBEGIN'="")
IF $$END(BGUSUB(BGUSTLEV))
SET BGUSUB(BGUSTLEV)=""
SET BGULAST=""
QUIT
+9 IF BGUFMCK
IF $EXTRACT(BGUSUB(BGUSTLEV),1,BGUFMCK)'=BGUBEGIN
QUIT
+10 IF BGUVLST=""
Begin DoDot:2
+11 IF BGUCRFS=""
SET BGUDAT=$$GETDATA(0)
Begin DoDot:3
+12 IF BGUDCK#2
DO COUNT
DO SETDATA($CHAR(175)_BGUSUB(BGULEV)_$CHAR(20)_"0"_$CHAR(25)_BGUDAT,BGUICNT1,BGUCNT)
QUIT
End DoDot:3
QUIT
+13 SET BGUTIEN=$ORDER(@BGUGREF@(""))
SET BGUDAT=$$GETDATA(BGUTIEN)
IF BGUDCK#2
DO COUNT
DO SETDATA($CHAR(175)_BGUTIEN_$CHAR(20)_"0"_$CHAR(25)_BGUDAT,BGUICNT1,BGUCNT)
QUIT
End DoDot:2
QUIT
+14 DO FIELDS
End DoDot:1
IF BGUSUB(BGUSTLEV)=""!(BGUICNT#BGUMAX=0&BGUICNT)
QUIT
+15 SET BGULAST=BGUSUB(BGUSTLEV)
+16 QUIT
+17 ;
FIELDS ;EP GENERAL CALL FROM BPC,BGU NAMESPACE
+1 SET BGUPFILE=BGUGREF
SET BGUSLEV=BGULEV
SET BGUN=""
+2 MERGE BGUSVSUB=BGUSUB
+3 DO ^BGULIST1
+4 SET BGUGREF=BGUPFILE
SET BGULEV=BGUSLEV
+5 KILL BGUPFILE,BGUSLEV,BGUSUB
+6 MERGE BGUSUB=BGUSVSUB
+7 KILL BGUSVSUB
+8 QUIT
+9 ;
DOLRO(BGUX,BGUDIRX) ;INTERNAL EP
+1 IF BGULLEV'=BGUX
SET BGUGREF=$$SETGREF(BGUGBL)
SET BGULLEV=BGUX
+2 SET BGUDIRX=$GET(BGUDIRX,1)
SET BGUY=$ORDER(@BGUGREF,BGUDIRX)
+3 QUIT BGUY
+4 ;
SETGREF(BGUX) ;INTERNAL EP
+1 SET BGUY=""
+2 FOR BGUN=1:1:BGULEV
IF BGUN>1
SET BGUY=BGUY_","
SET BGUY=BGUY_"BGUSUB("_BGUN_")"
+3 SET BGUY=BGUX_BGUY_")"
+4 QUIT BGUY
+5 ;
GETDATA(BGUX) ;INTERNAL EP
+1 IF $DATA(BGUX)
SET BGUDCK=$DATA(@BGUGREF@(BGUX))
SET BGUY=$GET(^(BGUX))
QUIT BGUY
+2 SET BGUDCK=$DATA(@BGUGREF)
SET BGUY=$GET(^(BGUSUB(BGULEV)))
QUIT BGUY
+3 QUIT BGUY
+4 ;
SETDATA(BGUX,BGUXN,BGUXN1) ;INTERNAL EP
+1 SET ^TMP("BGULIST",BGUID,BGUXN,BGUXN1)=BGUX
+2 QUIT
+3 ;
BEGIN(BGUX) ;INTERNAL EP
+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) ;INTERNAL EP
+1 Begin DoDot:1
+2 IF BGUDIR1=1
Begin DoDot:2
+3 IF BGUEND=""
SET BGUY=BGUX=""
QUIT
+4 IF BGUX
IF BGUEND
IF BGUX=+BGUX
IF BGUEND=+BGUEND
SET BGUY=BGUX>BGUEND
QUIT
+5 SET BGUY=BGUX]]BGUEND
End DoDot:2
QUIT
+6 IF BGUX=""
SET BGUY=1
QUIT
+7 IF BGUX
IF BGUBEGIN
IF BGUX=+BGUX
IF BGUBEGIN=+BGUBEGIN
SET BGUY=BGUX<BGUBEGIN
QUIT
+8 SET BGUY=BGUBEGIN]]BGUX
End DoDot:1
+9 QUIT BGUY
+10 ;
+11 ; Input: FileMan name Returns: FileMan file number
GETFID(BGUX) ;INTERNAL EP
+1 IF 'BGUX
SET BGUX=$ORDER(^DIC("B",BGUX,""))
IF BGUX=""
QUIT ""
+2 IF '$DATA(^DIC(BGUX))
QUIT ""
+3 QUIT BGUX
+4 ;
COUNT ;
+1 SET BGUICNT=BGUICNT+1
SET BGUICNT1=BGUICNT
SET BGUCNT=1
IF BGUDIR1<0
SET BGUICNT1=BGUMAX+1-BGUICNT1
+2 QUIT
+3 ;
ERROR ;
+1 DO SETDATA(-1,0,0)
DO SETDATA(BGUERMSG,0,1)
+2 QUIT
+3 ;
KILL1 ;
+1 KILL BGUARSBS,BGUASBS,BGUCNT,BGUDAT,BGUDATP,BGUDCK,BGUDIR1,BGUDIRX,BGUDNODE,BGUDSET,BGUFILE1,BGUFN,BGUFN1,BGUFSET,BGUGLEV,BGUGNODE,BGUGOTD,BGUICNT,BGUICNT1,BGUIDX,BGULFRST,BGULICNT,BGULIEN,BGULLAST,BGULLEV,BGUN,BGUOFL
+2 KILL BGUOFN,BGUPFIL1,BGUPFILE,BGULKU,BGULKUA,BGUREF,BGUSBS,BGUSETD,BGUSLEV,BGUSLEV1,BGUTDLM,BGUTVSET,BGUV,BGUX,BGUX1,BGUXAR,BGUXFN1,BGUXLFID,BGUXN,BGUXN1,BGUXNE1,BGUXNE2,BGUXSBNS,BGUXSBS,BGUY,BGUYP
+3 QUIT
+4 ;
KILL ;
+1 KILL BGUDRIVR,BGUDRVRR,BGUARSBS,BGUASBS,BGUCGBL,BGUCGREF,BGUCHNG,BGUCNT,BGUCRFS1,BGUDAT,BGUDATP,BGUDCK,BGUDIR1,BGUDIRX,BGUDSET,BGUERMSG,BGUERROR,BGUFGBL,BGUFIEN,BGUFILE1,BGUFIRST,BGUFLDS,BGUFMCK,BGUFN,BGUFN1,BGUFSET,BGUGBL,BGUGNODE
+2 KILL BGUGOTD,BGUGREF,BGUICNT,BGUICNT1,BGUIDX,BGUIVS,BGULAST,BGULCNDS,BGULCRFS,BGULDIR,BGULEV,BGULFILE,BGULICNT,BGULIEN,BGULKU,BGULKUA,BGULLEV,BGULSIEN,BGULVLST,BGUMGBL,BGUN,BGUN1,BGUN2,BGUOFILE,BGUOFL,BGUOFN,BGUOLEV,BGUOVS
+3 KILL BGUPFIL1,BGUPFILE,BGUPTR,BGUSBS,BGUSETD,BGUSF,BGUSLEV,BGUSLEV1,BGUSTART,BGUSTLEV,BGUSUB,BGUSVSB1,BGUSVSUB,BGUTDLM,BGUTIEN,BGUTNODE,BGUTNOLV,BGUTVSET,BGUV,BGUX,BGUX1,BGUXAR,BGUXFN1,BGUXN,BGUXN1,BGUXSBS,BGUXX,BGUY,BGUYP
+4 KILL BGUYY
+5 IF $GET(BGUCNDS)'=""
DO KILL^BGUCND
+6 QUIT
