BPCSC ; IHS/OIT/MJL - SPECIAL CROSS REFERENCE ROUTINE ;
;;1.5;BPC;;MAY 26, 2005
;
DX ;FHL 12/31/99
S BGUCRFS1="AIHS"
I BGUBEGIN?.N1".".N!(BGUBEGIN?1"V".N.1".".N)!(BGUBEGIN="") D Q
.I BGUBEGIN'="",$D(^ICD9("BA",BGUBEGIN)) D Q:BGUIEN'=""
..S BGUIEN=$O(^ICD9("BA",BGUBEGIN,""))
..I BGUIEN'="" S (BGUBEGIN,BGUEND,BGUCRFS,BGUCRFS1)=""
.S BGUCRFS1="BA"
I BGUBEGIN?1N.N D
.S BGUCRFS1="BA"
.S BGUBEGIN=BGUBEGIN_"."
.S BGUEND=BGUBEGIN_"~"
Q
INTERACT ;
I '$D(BGUDRIVR) D Q
.S BGUDRIVR="INTERACT^BPCSC",BGUCRFS="",BPCDIEN2=BGUBEGIN
.S BPCDIEN1=BGUEND,BGUMAX=32000
.S (BGUBEGIN,BGUEND)=""
Q:BPCDIEN1=""!(BPCDIEN2="")
I $D(^PSDRUG(BPCDIEN1,"ND")),$D(^PSDRUG(BPCDIEN2,"ND")) D INTACT1
Q
INTACT1 ;
S BPCND=^PSDRUG(BPCDIEN1,"ND"),BPCNDF1=$P(BPCND,"^",1)_"A"_$P(BPCND,"^",3)
S BPCND=^PSDRUG(BPCDIEN2,"ND"),BPCNDF2=$P(BPCND,"^",1)_"A"_$P(BPCND,"^",3)
S BPCIEN=$O(^PS(56,"APD",BPCNDF1,BPCNDF2,0)) Q:BPCIEN=""
S BGUSUB(1)=BPCIEN D FIELDS^BGULIST
;F BPCX=1:1:$L(BPCDIENS,"`") D
.S BPCDRGI=$P(BPCDIENS,"`",BPCX)
.I $D(^PSDRUG(BPCDRGI,"ND")) D
..S BPCND=^PSDRUG(BPCDRGI,"ND")
..S BPCNDF1=$P(BPCND,"^",1)_"A"_$P(BPCND,"^",3)
..S BPCIEN=$O(^PS(56,"APD",BPCNDF1,BPCNDF2,0)) Q:BPCIEN=""
..S BGUSUB(1)=BPCIEN D FIELDS^BGULIST
Q
MEDS ;
I '$D(BGUDRIVR) D Q
.S BGUDRIVR="MEDS^BPCSC",BGUCRFS="",BPCPIEN=BGUBEGIN
.S BPCOPT=$P(BGUEND,"`",1),BPCSDATE=$P(BGUEND,"`",2)
.S BPCEDATE=$P(BGUEND,"`",3),BPCLIM=BGUMAX,BGUMAX=32000
.S (BGUBEGIN,BGUEND)=""
Q:BPCPIEN=""
S:BPCOPT=2 BPCLIM=9999999
S BPCC=0,BPCX=0 F S BPCX=$O(^AUPNVSIT("AA",BPCPIEN,BPCX)) Q:BPCX=""!(BPCC=BPCLIM) D
.S BPCVIEN="" F S BPCVIEN=$O(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN)) Q:BPCVIEN=""!(BPCC=BPCLIM) D
..I BPCOPT=3,'$D(^AUPNVLAB("AD",BPCVIEN)) Q
..S BPCY=^AUPNVSIT(BPCVIEN,0),BPCVDT=$P(BPCY,U,1),BPCCKD=$P(BPCVDT,".",1)
..I BPCSDATE'="",BPCEDATE'="",((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE)) Q
..S BPCVMIEN=0,BPCC=BPCC+1 F S BPCVMIEN=$O(^AUPNVMED("AD",BPCVIEN,BPCVMIEN)) Q:BPCVMIEN="" D
...S BPCSTAT=0
...I $D(^PSRX("APCC",BPCVMIEN)) D
....S BPCRXIEN=$O(^PSRX("APCC",BPCVMIEN,"")) Q:BPCRXIEN=""
....S BPCCK=$O(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
....I BPCCK'="" S BPCSTAT=-1 Q
....S BPCSTAT=+$P(^PSRX(BPCRXIEN,0),"^",15)
...I BPCSTAT=0 S BGUSUB(1)=BPCVMIEN D FIELDS^BGULIST
Q
RAD ;
I '$D(BGUDRIVR) D Q
.S BGUDRIVR="RAD^BPCSC",BGUCRFS="",BPCPIEN=BGUBEGIN
.S BPCOPT=$P(BGUEND,"`",1),BPCSDATE=$P(BGUEND,"`",2)
.S BPCEDATE=$P(BGUEND,"`",3),BPCLIM=BGUMAX,BGUMAX=32000
.S (BGUBEGIN,BGUEND)=""
Q:BPCPIEN=""
S:BPCOPT=2 BPCLIM=9999999
S BPCC=0,BPCX=0 F S BPCX=$O(^AUPNVSIT("AA",BPCPIEN,BPCX)) Q:BPCX=""!(BPCC=BPCLIM) D
.S BPCVIEN="" F S BPCVIEN=$O(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN)) Q:BPCVIEN=""!(BPCC=BPCLIM) D
..I BPCOPT=3,'$D(^AUPNVLAB("AD",BPCVIEN)) Q
..S BPCY=^AUPNVSIT(BPCVIEN,0),BPCVDT=$P(BPCY,U,1),BPCCKD=$P(BPCVDT,".",1)
..I BPCSDATE'="",BPCEDATE'="",((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE)) Q
..S BPCVMIEN=0,BPCC=BPCC+1 F S BPCVMIEN=$O(^AUPNVRAD("AD",BPCVIEN,BPCVMIEN)) Q:BPCVMIEN="" D
...S BPCSTAT=0
...I $D(^PSRX("APCC",BPCVMIEN)) D
....S BPCRXIEN=$O(^PSRX("APCC",BPCVMIEN,"")) Q:BPCRXIEN=""
....S BPCCK=$O(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
....I BPCCK'="" S BPCSTAT=-1 Q
....S BPCSTAT=+$P(^PSRX(BPCRXIEN,0),"^",15)
...I BPCSTAT=0 S BGUSUB(1)=BPCVMIEN D FIELDS^BGULIST
Q
EDP ;
I '$D(BGUDRIVR) D Q
.S BGUDRIVR="MEDS^BPCSC",BGUCRFS="",BPCPIEN=BGUBEGIN
.S BPCOPT=$P(BGUEND,"`",1),BPCSDATE=$P(BGUEND,"`",2)
.S BPCEDATE=$P(BGUEND,"`",3),BPCLIM=BGUMAX,BGUMAX=32000
.S (BGUBEGIN,BGUEND)=""
Q:BPCPIEN=""
S:BPCOPT=2 BPCLIM=9999999
S BPCC=0,BPCX=0 F S BPCX=$O(^AUPNVSIT("AA",BPCPIEN,BPCX)) Q:BPCX=""!(BPCC=BPCLIM) D
.S BPCVIEN="" F S BPCVIEN=$O(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN)) Q:BPCVIEN=""!(BPCC=BPCLIM) D
..I BPCOPT=3,'$D(^AUPNVLAB("AD",BPCVIEN)) Q
..S BPCY=^AUPNVSIT(BPCVIEN,0),BPCVDT=$P(BPCY,U,1),BPCCKD=$P(BPCVDT,".",1)
..I BPCSDATE'="",BPCEDATE'="",((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE)) Q
..S BPCVMIEN=0,BPCC=BPCC+1 F S BPCVMIEN=$O(^AUPNVMED("AD",BPCVIEN,BPCVMIEN)) Q:BPCVMIEN="" D
...S BPCSTAT=0
...I $D(^PSRX("APCC",BPCVMIEN)) D
....S BPCRXIEN=$O(^PSRX("APCC",BPCVMIEN,"")) Q:BPCRXIEN=""
....S BPCCK=$O(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
....I BPCCK'="" S BPCSTAT=-1 Q
....S BPCSTAT=+$P(^PSRX(BPCRXIEN,0),"^",15)
...I BPCSTAT=0 S BGUSUB(1)=BPCVMIEN D FIELDS^BGULIST
Q
XXXX ;
I '$D(BGUDRIVR) D Q
.S BGUDRIVR="MEDS^BPCSC",BGUCRFS="",BPCPIEN=BGUBEGIN
.S BPCOPT=$P(BGUEND,"`",1),BPCSDATE=$P(BGUEND,"`",2)
.S BPCEDATE=$P(BGUEND,"`",3),BPCLIM=BGUMAX,BGUMAX=32000
.S (BGUBEGIN,BGUEND)=""
Q:BPCPIEN=""
S:BPCOPT=2 BPCLIM=9999999
S BPCC=0,BPCX=0 F S BPCX=$O(^AUPNVSIT("AA",BPCPIEN,BPCX)) Q:BPCX=""!(BPCC=BPCLIM) D
.S BPCVIEN="" F S BPCVIEN=$O(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN)) Q:BPCVIEN=""!(BPCC=BPCLIM) D
..I BPCOPT=3,'$D(^AUPNVLAB("AD",BPCVIEN)) Q
..S BPCY=^AUPNVSIT(BPCVIEN,0),BPCVDT=$P(BPCY,U,1),BPCCKD=$P(BPCVDT,".",1)
..I BPCSDATE'="",BPCEDATE'="",((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE)) Q
..S BPCVMIEN=0,BPCC=BPCC+1 F S BPCVMIEN=$O(^AUPNVMED("AD",BPCVIEN,BPCVMIEN)) Q:BPCVMIEN="" D
...S BPCSTAT=0
...I $D(^PSRX("APCC",BPCVMIEN)) D
....S BPCRXIEN=$O(^PSRX("APCC",BPCVMIEN,"")) Q:BPCRXIEN=""
....S BPCCK=$O(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
....I BPCCK'="" S BPCSTAT=-1 Q
....S BPCSTAT=+$P(^PSRX(BPCRXIEN,0),"^",15)
...I BPCSTAT=0 S BGUSUB(1)=BPCVMIEN D FIELDS^BGULIST
Q
BPCSC ; IHS/OIT/MJL - SPECIAL CROSS REFERENCE ROUTINE ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
DX ;FHL 12/31/99
+1 SET BGUCRFS1="AIHS"
+2 IF BGUBEGIN?.N1".".N!(BGUBEGIN?1"V".N.1".".N)!(BGUBEGIN="")
Begin DoDot:1
+3 IF BGUBEGIN'=""
IF $DATA(^ICD9("BA",BGUBEGIN))
Begin DoDot:2
+4 SET BGUIEN=$ORDER(^ICD9("BA",BGUBEGIN,""))
+5 IF BGUIEN'=""
SET (BGUBEGIN,BGUEND,BGUCRFS,BGUCRFS1)=""
End DoDot:2
IF BGUIEN'=""
QUIT
+6 SET BGUCRFS1="BA"
End DoDot:1
QUIT
+7 IF BGUBEGIN?1N.N
Begin DoDot:1
+8 SET BGUCRFS1="BA"
+9 SET BGUBEGIN=BGUBEGIN_"."
+10 SET BGUEND=BGUBEGIN_"~"
End DoDot:1
+11 QUIT
INTERACT ;
+1 IF '$DATA(BGUDRIVR)
Begin DoDot:1
+2 SET BGUDRIVR="INTERACT^BPCSC"
SET BGUCRFS=""
SET BPCDIEN2=BGUBEGIN
+3 SET BPCDIEN1=BGUEND
SET BGUMAX=32000
+4 SET (BGUBEGIN,BGUEND)=""
End DoDot:1
QUIT
+5 IF BPCDIEN1=""!(BPCDIEN2="")
QUIT
+6 IF $DATA(^PSDRUG(BPCDIEN1,"ND"))
IF $DATA(^PSDRUG(BPCDIEN2,"ND"))
DO INTACT1
+7 QUIT
INTACT1 ;
+1 SET BPCND=^PSDRUG(BPCDIEN1,"ND")
SET BPCNDF1=$PIECE(BPCND,"^",1)_"A"_$PIECE(BPCND,"^",3)
+2 SET BPCND=^PSDRUG(BPCDIEN2,"ND")
SET BPCNDF2=$PIECE(BPCND,"^",1)_"A"_$PIECE(BPCND,"^",3)
+3 SET BPCIEN=$ORDER(^PS(56,"APD",BPCNDF1,BPCNDF2,0))
IF BPCIEN=""
QUIT
+4 SET BGUSUB(1)=BPCIEN
DO FIELDS^BGULIST
+5 ;F BPCX=1:1:$L(BPCDIENS,"`") D
+6
*** ERROR ***
+7
*** ERROR ***
+8
*** ERROR ***
+9
*** ERROR ***
+10
*** ERROR ***
+11
*** ERROR ***
+12 QUIT
MEDS ;
+1 IF '$DATA(BGUDRIVR)
Begin DoDot:1
+2 SET BGUDRIVR="MEDS^BPCSC"
SET BGUCRFS=""
SET BPCPIEN=BGUBEGIN
+3 SET BPCOPT=$PIECE(BGUEND,"`",1)
SET BPCSDATE=$PIECE(BGUEND,"`",2)
+4 SET BPCEDATE=$PIECE(BGUEND,"`",3)
SET BPCLIM=BGUMAX
SET BGUMAX=32000
+5 SET (BGUBEGIN,BGUEND)=""
End DoDot:1
QUIT
+6 IF BPCPIEN=""
QUIT
+7 IF BPCOPT=2
SET BPCLIM=9999999
+8 SET BPCC=0
SET BPCX=0
FOR
SET BPCX=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX))
IF BPCX=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:1
+9 SET BPCVIEN=""
FOR
SET BPCVIEN=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN))
IF BPCVIEN=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:2
+10 IF BPCOPT=3
IF '$DATA(^AUPNVLAB("AD",BPCVIEN))
QUIT
+11 SET BPCY=^AUPNVSIT(BPCVIEN,0)
SET BPCVDT=$PIECE(BPCY,U,1)
SET BPCCKD=$PIECE(BPCVDT,".",1)
+12 IF BPCSDATE'=""
IF BPCEDATE'=""
IF ((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE))
QUIT
+13 SET BPCVMIEN=0
SET BPCC=BPCC+1
FOR
SET BPCVMIEN=$ORDER(^AUPNVMED("AD",BPCVIEN,BPCVMIEN))
IF BPCVMIEN=""
QUIT
Begin DoDot:3
+14 SET BPCSTAT=0
+15 IF $DATA(^PSRX("APCC",BPCVMIEN))
Begin DoDot:4
+16 SET BPCRXIEN=$ORDER(^PSRX("APCC",BPCVMIEN,""))
IF BPCRXIEN=""
QUIT
+17 SET BPCCK=$ORDER(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
+18 IF BPCCK'=""
SET BPCSTAT=-1
QUIT
+19 SET BPCSTAT=+$PIECE(^PSRX(BPCRXIEN,0),"^",15)
End DoDot:4
+20 IF BPCSTAT=0
SET BGUSUB(1)=BPCVMIEN
DO FIELDS^BGULIST
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
RAD ;
+1 IF '$DATA(BGUDRIVR)
Begin DoDot:1
+2 SET BGUDRIVR="RAD^BPCSC"
SET BGUCRFS=""
SET BPCPIEN=BGUBEGIN
+3 SET BPCOPT=$PIECE(BGUEND,"`",1)
SET BPCSDATE=$PIECE(BGUEND,"`",2)
+4 SET BPCEDATE=$PIECE(BGUEND,"`",3)
SET BPCLIM=BGUMAX
SET BGUMAX=32000
+5 SET (BGUBEGIN,BGUEND)=""
End DoDot:1
QUIT
+6 IF BPCPIEN=""
QUIT
+7 IF BPCOPT=2
SET BPCLIM=9999999
+8 SET BPCC=0
SET BPCX=0
FOR
SET BPCX=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX))
IF BPCX=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:1
+9 SET BPCVIEN=""
FOR
SET BPCVIEN=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN))
IF BPCVIEN=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:2
+10 IF BPCOPT=3
IF '$DATA(^AUPNVLAB("AD",BPCVIEN))
QUIT
+11 SET BPCY=^AUPNVSIT(BPCVIEN,0)
SET BPCVDT=$PIECE(BPCY,U,1)
SET BPCCKD=$PIECE(BPCVDT,".",1)
+12 IF BPCSDATE'=""
IF BPCEDATE'=""
IF ((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE))
QUIT
+13 SET BPCVMIEN=0
SET BPCC=BPCC+1
FOR
SET BPCVMIEN=$ORDER(^AUPNVRAD("AD",BPCVIEN,BPCVMIEN))
IF BPCVMIEN=""
QUIT
Begin DoDot:3
+14 SET BPCSTAT=0
+15 IF $DATA(^PSRX("APCC",BPCVMIEN))
Begin DoDot:4
+16 SET BPCRXIEN=$ORDER(^PSRX("APCC",BPCVMIEN,""))
IF BPCRXIEN=""
QUIT
+17 SET BPCCK=$ORDER(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
+18 IF BPCCK'=""
SET BPCSTAT=-1
QUIT
+19 SET BPCSTAT=+$PIECE(^PSRX(BPCRXIEN,0),"^",15)
End DoDot:4
+20 IF BPCSTAT=0
SET BGUSUB(1)=BPCVMIEN
DO FIELDS^BGULIST
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
EDP ;
+1 IF '$DATA(BGUDRIVR)
Begin DoDot:1
+2 SET BGUDRIVR="MEDS^BPCSC"
SET BGUCRFS=""
SET BPCPIEN=BGUBEGIN
+3 SET BPCOPT=$PIECE(BGUEND,"`",1)
SET BPCSDATE=$PIECE(BGUEND,"`",2)
+4 SET BPCEDATE=$PIECE(BGUEND,"`",3)
SET BPCLIM=BGUMAX
SET BGUMAX=32000
+5 SET (BGUBEGIN,BGUEND)=""
End DoDot:1
QUIT
+6 IF BPCPIEN=""
QUIT
+7 IF BPCOPT=2
SET BPCLIM=9999999
+8 SET BPCC=0
SET BPCX=0
FOR
SET BPCX=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX))
IF BPCX=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:1
+9 SET BPCVIEN=""
FOR
SET BPCVIEN=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN))
IF BPCVIEN=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:2
+10 IF BPCOPT=3
IF '$DATA(^AUPNVLAB("AD",BPCVIEN))
QUIT
+11 SET BPCY=^AUPNVSIT(BPCVIEN,0)
SET BPCVDT=$PIECE(BPCY,U,1)
SET BPCCKD=$PIECE(BPCVDT,".",1)
+12 IF BPCSDATE'=""
IF BPCEDATE'=""
IF ((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE))
QUIT
+13 SET BPCVMIEN=0
SET BPCC=BPCC+1
FOR
SET BPCVMIEN=$ORDER(^AUPNVMED("AD",BPCVIEN,BPCVMIEN))
IF BPCVMIEN=""
QUIT
Begin DoDot:3
+14 SET BPCSTAT=0
+15 IF $DATA(^PSRX("APCC",BPCVMIEN))
Begin DoDot:4
+16 SET BPCRXIEN=$ORDER(^PSRX("APCC",BPCVMIEN,""))
IF BPCRXIEN=""
QUIT
+17 SET BPCCK=$ORDER(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
+18 IF BPCCK'=""
SET BPCSTAT=-1
QUIT
+19 SET BPCSTAT=+$PIECE(^PSRX(BPCRXIEN,0),"^",15)
End DoDot:4
+20 IF BPCSTAT=0
SET BGUSUB(1)=BPCVMIEN
DO FIELDS^BGULIST
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
XXXX ;
+1 IF '$DATA(BGUDRIVR)
Begin DoDot:1
+2 SET BGUDRIVR="MEDS^BPCSC"
SET BGUCRFS=""
SET BPCPIEN=BGUBEGIN
+3 SET BPCOPT=$PIECE(BGUEND,"`",1)
SET BPCSDATE=$PIECE(BGUEND,"`",2)
+4 SET BPCEDATE=$PIECE(BGUEND,"`",3)
SET BPCLIM=BGUMAX
SET BGUMAX=32000
+5 SET (BGUBEGIN,BGUEND)=""
End DoDot:1
QUIT
+6 IF BPCPIEN=""
QUIT
+7 IF BPCOPT=2
SET BPCLIM=9999999
+8 SET BPCC=0
SET BPCX=0
FOR
SET BPCX=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX))
IF BPCX=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:1
+9 SET BPCVIEN=""
FOR
SET BPCVIEN=$ORDER(^AUPNVSIT("AA",BPCPIEN,BPCX,BPCVIEN))
IF BPCVIEN=""!(BPCC=BPCLIM)
QUIT
Begin DoDot:2
+10 IF BPCOPT=3
IF '$DATA(^AUPNVLAB("AD",BPCVIEN))
QUIT
+11 SET BPCY=^AUPNVSIT(BPCVIEN,0)
SET BPCVDT=$PIECE(BPCY,U,1)
SET BPCCKD=$PIECE(BPCVDT,".",1)
+12 IF BPCSDATE'=""
IF BPCEDATE'=""
IF ((BPCCKD<BPCSDATE)!(BPCCKD>BPCEDATE))
QUIT
+13 SET BPCVMIEN=0
SET BPCC=BPCC+1
FOR
SET BPCVMIEN=$ORDER(^AUPNVMED("AD",BPCVIEN,BPCVMIEN))
IF BPCVMIEN=""
QUIT
Begin DoDot:3
+14 SET BPCSTAT=0
+15 IF $DATA(^PSRX("APCC",BPCVMIEN))
Begin DoDot:4
+16 SET BPCRXIEN=$ORDER(^PSRX("APCC",BPCVMIEN,""))
IF BPCRXIEN=""
QUIT
+17 SET BPCCK=$ORDER(^PSRX("APCC",BPCVMIEN,BPCRXIEN,""))
+18 IF BPCCK'=""
SET BPCSTAT=-1
QUIT
+19 SET BPCSTAT=+$PIECE(^PSRX(BPCRXIEN,0),"^",15)
End DoDot:4
+20 IF BPCSTAT=0
SET BGUSUB(1)=BPCVMIEN
DO FIELDS^BGULIST
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
