BPCPC1 ; IHS/OIT/MJL - PATIENT CHART GUI ROUTINES ;
;;1.5;BPC;;MAY 26, 2005
DUPPAT(RESULT,BPCNAM,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETDUPPAT
S U="^",BPCSUB=$J K ^BGURES(BPCSUB),RESULT
S RESULT="^BGURES("_BPCSUB_")"
S BPCNAM=$G(BPCNAM),BPCPARAM=$G(BPCPARAM)
I BPCNAM="" S ^BGURES(BPCSUB,1)="-1",^BGURES(BPCSUB,2)="No Patient Name Parameter Sent!" D KILL Q
S BPCX=$O(^DPT("B",BPCNAM),-1),BPCC=0,BPCCTR=1 D GETNAM,KILL
Q
KILL ;
K BPCX,BPCY,BPCCTR,BPCC,BPCD,BPCSEX,BPCDOB,BPCSTR,BPCSUB,BPCSSN
Q
GETNAM ;
F S BPCX=$O(^DPT("B",BPCX)) Q:BPCX=""!($E(BPCX,1,$L(BPCNAM))'=BPCNAM) D
.S BPCY="" F S BPCY=$O(^DPT("B",BPCX,BPCY)) Q:BPCY="" D
..S BPCD=^DPT(BPCY,0),BPCRNAM=$P(BPCD,U,1) Q:BPCX'=BPCRNAM
..S BPCSEX=$P(BPCD,U,2)
..S BPCSEX=$S(BPCSEX="F":"FEMALE",BPCSEX="M":"MALE",1:"UNKNOWN")
..S BPCDOB=$P(BPCD,U,3),BPCSSN=$P(BPCD,U,9)
..S BPCD=$G(^DPT(BPCY,".24")),BPCMMN=$P(BPCD,U,3)
..S BPCSTR=BPCX_U_BPCSEX_U_BPCDOB_U_BPCSSN_U_BPCMMN
..S BPCC=BPCC+1,BPCCTR=BPCCTR+1
..S ^BGURES(BPCSUB,BPCCTR)=BPCSTR,^BGURES(BPCSUB,1)=BPCC
I BPCC=0 S ^BGURES(BPCSUB,1)=-2,^BGURES(BPCSUB,2)="NO DUPLICATES"
Q
BENELIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETBENEFICIARIES
S U="^",XWBWRAP=1,BPCSUB=$J K ^BGURES(BPCSUB),RESULT
S RESULT="^BGURES("_BPCSUB_")"
S BPCX=$G(BPCX),BPCMAX=$G(BPCMAX),BPCMORE=$G(BPCMORE),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX),BPCCTR=0,BPCFLAG=0
S BPCN="" S:BPCX'="" BPCN=$O(^AUTTBEN("B",BPCX),-1)
S:'BPCMAX BPCMAX=50
I BPCMORE'="" D MORE I BPCFLAG D KILL Q
D GETBEN,KILL
Q
GETBEN ;
F S BPCN=$O(^AUTTBEN("B",BPCN)) Q:BPCN="" D Q:BPCFLAG
.I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
.S BPCIEN="" F S BPCIEN=$O(^AUTTBEN("B",BPCN,BPCIEN)) Q:BPCIEN="" D Q:BPCFLAG
..I BPCCTR=BPCMAX D Q
...S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN
...S BPCFLAG=1
..S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
S ^BGURES(BPCSUB,0)=BPCCTR
Q
MORE ;
S BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2),BPCCTR=BPCCTR+1
S ^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
I BPCCTR=BPCMAX S BPCFLAG=1
Q
TRIBLIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETTRIBES
S U="^",XWBWRAP=1,BPCSUB=$J K ^BGURES(BPCSUB),RESULT
S RESULT="^BGURES("_BPCSUB_")"
S BPCX=$G(BPCX),BPCMAX=$G(BPCMAX),BPCMORE=$G(BPCMORE),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX),BPCCTR=0,BPCFLAG=0
S BPCN="" S:BPCX'="" BPCN=$O(^AUTTTRI("B",BPCX),-1)
S:'BPCMAX BPCMAX=50
I BPCMORE'="" D MORE I BPCFLAG D KILL Q
D GETTRI,KILL
Q
GETTRI ;
F S BPCN=$O(^AUTTTRI("B",BPCN)) Q:BPCN="" D Q:BPCFLAG
.I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
.S BPCIEN="" F S BPCIEN=$O(^AUTTTRI("B",BPCN,BPCIEN)) Q:BPCIEN="" D Q:BPCFLAG
..I BPCCTR=BPCMAX D Q
...S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN
...S BPCFLAG=1
..S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
S ^BGURES(BPCSUB,0)=BPCCTR
Q
COMLIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETCOMMUNITIES
S U="^",XWBWRAP=1,BPCSUB=$J K ^BGURES(BPCSUB),RESULT
S RESULT="^BGURES("_BPCSUB_")"
S BPCX=$G(BPCX),BPCMAX=$G(BPCMAX),BPCMORE=$G(BPCMORE),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX),BPCCTR=0,BPCFLAG=0
S BPCN="" S:BPCX'="" BPCN=$O(^AUTTCOM("B",BPCX),-1)
S:'BPCMAX BPCMAX=50
I BPCMORE'="" D MORECOM I BPCFLAG D KILL Q
D GETCOM,KILL
Q
GETCOM ;
F S BPCN=$O(^AUTTCOM("B",BPCN)) Q:BPCN="" D Q:BPCFLAG
.I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
.S BPCIEN="" F S BPCIEN=$O(^AUTTCOM("B",BPCN,BPCIEN)) Q:BPCIEN="" D Q:BPCFLAG
..S BPCD=^AUTTCOM(BPCIEN,0),BPCCTY=$P(BPCD,U,2),BPCST=$P(BPCD,U,3)
..S BPCCTY=$P($G(^AUTTCTY(BPCCTY,0)),U,1)
..S BPCST=$P($G(^DIC(5,BPCST,0)),U,1)
..I BPCCTR=BPCMAX D Q
...S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN_"|"_BPCCTY_"|"_BPCST
...S BPCFLAG=1
..S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN_U_BPCCTY_U_BPCST
S ^BGURES(BPCSUB,0)=BPCCTR
Q
MORECOM ;
S BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2)
S BPCCTY=$P(BPCMORE,"|",3),BPCST=$P(BPCMORE,"|",4),BPCCTR=BPCCTR+1
S ^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN_U_BPCCTY_U_BPCST
I BPCCTR=BPCMAX S BPCFLAG=1
Q
STLIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETSTATES
S U="^",XWBWRAP=1,BPCSUB=$J K ^BGURES(BPCSUB),RESULT
S RESULT="^BGURES("_BPCSUB_")"
S BPCX=$G(BPCX),BPCMAX=$G(BPCMAX),BPCMORE=$G(BPCMORE),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX),BPCCTR=0,BPCFLAG=0
I BPCX'="" D CKCXF I BPCFLAG D KILL Q
S BPCN="" S:BPCX'="" BPCN=$O(^DIC(5,"B",BPCX),-1)
S:'BPCMAX BPCMAX=50
I BPCMORE'="" D MOREST I BPCFLAG D KILL Q
D GETST,KILL
Q
CKCXF ;
I $D(^DIC(5,"C",BPCX))=10 D Q
.S BPCIEN=$O(^DIC(5,"C",BPCX,"")) Q:BPCIEN=""
.S ^BGURES(BPCSUB,0)=1,^BGURES(BPCSUB,1)=BPCX_U_BPCIEN_U_$P(^DIC(5,BPCIEN,0),U,1)
.S BPCFLAG=1
Q
MOREST ;
S BPCCDE=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2)
S BPCN=$P(BPCMORE,"|",3),BPCCTR=BPCCTR+1
S ^BGURES(BPCSUB,BPCCTR)=BPCCDE_U_BPCIEN_U_BPCN
I BPCCTR=BPCMAX S BPCFLAG=1
Q
GETST ;
F S BPCN=$O(^DIC(5,"B",BPCN)) Q:BPCN="" D Q:BPCFLAG
.I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
.S BPCIEN="" F S BPCIEN=$O(^DIC(5,"B",BPCN,BPCIEN)) Q:BPCIEN="" D Q:BPCFLAG
..S BPCD=^DIC(5,BPCIEN,0),BPCCDE=$P(BPCD,U,2)
..I BPCCTR=BPCMAX D Q
...S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCCDE_"|"_BPCIEN_"|"_BPCN
...S BPCFLAG=1
..S BPCCTR=BPCCTR+1,^BGURES(BPCSUB,BPCCTR)=BPCCDE_U_BPCIEN_U_BPCN
S ^BGURES(BPCSUB,0)=BPCCTR
Q
BPCPC1 ; IHS/OIT/MJL - PATIENT CHART GUI ROUTINES ;
+1 ;;1.5;BPC;;MAY 26, 2005
DUPPAT(RESULT,BPCNAM,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETDUPPAT
+1 SET U="^"
SET BPCSUB=$JOB
KILL ^BGURES(BPCSUB),RESULT
+2 SET RESULT="^BGURES("_BPCSUB_")"
+3 SET BPCNAM=$GET(BPCNAM)
SET BPCPARAM=$GET(BPCPARAM)
+4 IF BPCNAM=""
SET ^BGURES(BPCSUB,1)="-1"
SET ^BGURES(BPCSUB,2)="No Patient Name Parameter Sent!"
DO KILL
QUIT
+5 SET BPCX=$ORDER(^DPT("B",BPCNAM),-1)
SET BPCC=0
SET BPCCTR=1
DO GETNAM
DO KILL
+6 QUIT
KILL ;
+1 KILL BPCX,BPCY,BPCCTR,BPCC,BPCD,BPCSEX,BPCDOB,BPCSTR,BPCSUB,BPCSSN
+2 QUIT
GETNAM ;
+1 FOR
SET BPCX=$ORDER(^DPT("B",BPCX))
IF BPCX=""!($EXTRACT(BPCX,1,$LENGTH(BPCNAM))'=BPCNAM)
QUIT
Begin DoDot:1
+2 SET BPCY=""
FOR
SET BPCY=$ORDER(^DPT("B",BPCX,BPCY))
IF BPCY=""
QUIT
Begin DoDot:2
+3 SET BPCD=^DPT(BPCY,0)
SET BPCRNAM=$PIECE(BPCD,U,1)
IF BPCX'=BPCRNAM
QUIT
+4 SET BPCSEX=$PIECE(BPCD,U,2)
+5 SET BPCSEX=$SELECT(BPCSEX="F":"FEMALE",BPCSEX="M":"MALE",1:"UNKNOWN")
+6 SET BPCDOB=$PIECE(BPCD,U,3)
SET BPCSSN=$PIECE(BPCD,U,9)
+7 SET BPCD=$GET(^DPT(BPCY,".24"))
SET BPCMMN=$PIECE(BPCD,U,3)
+8 SET BPCSTR=BPCX_U_BPCSEX_U_BPCDOB_U_BPCSSN_U_BPCMMN
+9 SET BPCC=BPCC+1
SET BPCCTR=BPCCTR+1
+10 SET ^BGURES(BPCSUB,BPCCTR)=BPCSTR
SET ^BGURES(BPCSUB,1)=BPCC
End DoDot:2
End DoDot:1
+11 IF BPCC=0
SET ^BGURES(BPCSUB,1)=-2
SET ^BGURES(BPCSUB,2)="NO DUPLICATES"
+12 QUIT
BENELIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETBENEFICIARIES
+1 SET U="^"
SET XWBWRAP=1
SET BPCSUB=$JOB
KILL ^BGURES(BPCSUB),RESULT
+2 SET RESULT="^BGURES("_BPCSUB_")"
+3 SET BPCX=$GET(BPCX)
SET BPCMAX=$GET(BPCMAX)
SET BPCMORE=$GET(BPCMORE)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
SET BPCCTR=0
SET BPCFLAG=0
+4 SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^AUTTBEN("B",BPCX),-1)
+5 IF 'BPCMAX
SET BPCMAX=50
+6 IF BPCMORE'=""
DO MORE
IF BPCFLAG
DO KILL
QUIT
+7 DO GETBEN
DO KILL
+8 QUIT
GETBEN ;
+1 FOR
SET BPCN=$ORDER(^AUTTBEN("B",BPCN))
IF BPCN=""
QUIT
Begin DoDot:1
+2 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+3 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^AUTTBEN("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
Begin DoDot:2
+4 IF BPCCTR=BPCMAX
Begin DoDot:3
+5 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN
+6 SET BPCFLAG=1
End DoDot:3
QUIT
+7 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
End DoDot:2
IF BPCFLAG
QUIT
End DoDot:1
IF BPCFLAG
QUIT
+8 SET ^BGURES(BPCSUB,0)=BPCCTR
+9 QUIT
MORE ;
+1 SET BPCN=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
SET BPCCTR=BPCCTR+1
+2 SET ^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
+3 IF BPCCTR=BPCMAX
SET BPCFLAG=1
+4 QUIT
TRIBLIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETTRIBES
+1 SET U="^"
SET XWBWRAP=1
SET BPCSUB=$JOB
KILL ^BGURES(BPCSUB),RESULT
+2 SET RESULT="^BGURES("_BPCSUB_")"
+3 SET BPCX=$GET(BPCX)
SET BPCMAX=$GET(BPCMAX)
SET BPCMORE=$GET(BPCMORE)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
SET BPCCTR=0
SET BPCFLAG=0
+4 SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^AUTTTRI("B",BPCX),-1)
+5 IF 'BPCMAX
SET BPCMAX=50
+6 IF BPCMORE'=""
DO MORE
IF BPCFLAG
DO KILL
QUIT
+7 DO GETTRI
DO KILL
+8 QUIT
GETTRI ;
+1 FOR
SET BPCN=$ORDER(^AUTTTRI("B",BPCN))
IF BPCN=""
QUIT
Begin DoDot:1
+2 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+3 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^AUTTTRI("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
Begin DoDot:2
+4 IF BPCCTR=BPCMAX
Begin DoDot:3
+5 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN
+6 SET BPCFLAG=1
End DoDot:3
QUIT
+7 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
End DoDot:2
IF BPCFLAG
QUIT
End DoDot:1
IF BPCFLAG
QUIT
+8 SET ^BGURES(BPCSUB,0)=BPCCTR
+9 QUIT
COMLIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETCOMMUNITIES
+1 SET U="^"
SET XWBWRAP=1
SET BPCSUB=$JOB
KILL ^BGURES(BPCSUB),RESULT
+2 SET RESULT="^BGURES("_BPCSUB_")"
+3 SET BPCX=$GET(BPCX)
SET BPCMAX=$GET(BPCMAX)
SET BPCMORE=$GET(BPCMORE)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
SET BPCCTR=0
SET BPCFLAG=0
+4 SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^AUTTCOM("B",BPCX),-1)
+5 IF 'BPCMAX
SET BPCMAX=50
+6 IF BPCMORE'=""
DO MORECOM
IF BPCFLAG
DO KILL
QUIT
+7 DO GETCOM
DO KILL
+8 QUIT
GETCOM ;
+1 FOR
SET BPCN=$ORDER(^AUTTCOM("B",BPCN))
IF BPCN=""
QUIT
Begin DoDot:1
+2 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+3 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^AUTTCOM("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
Begin DoDot:2
+4 SET BPCD=^AUTTCOM(BPCIEN,0)
SET BPCCTY=$PIECE(BPCD,U,2)
SET BPCST=$PIECE(BPCD,U,3)
+5 SET BPCCTY=$PIECE($GET(^AUTTCTY(BPCCTY,0)),U,1)
+6 SET BPCST=$PIECE($GET(^DIC(5,BPCST,0)),U,1)
+7 IF BPCCTR=BPCMAX
Begin DoDot:3
+8 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN_"|"_BPCCTY_"|"_BPCST
+9 SET BPCFLAG=1
End DoDot:3
QUIT
+10 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN_U_BPCCTY_U_BPCST
End DoDot:2
IF BPCFLAG
QUIT
End DoDot:1
IF BPCFLAG
QUIT
+11 SET ^BGURES(BPCSUB,0)=BPCCTR
+12 QUIT
MORECOM ;
+1 SET BPCN=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
+2 SET BPCCTY=$PIECE(BPCMORE,"|",3)
SET BPCST=$PIECE(BPCMORE,"|",4)
SET BPCCTR=BPCCTR+1
+3 SET ^BGURES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN_U_BPCCTY_U_BPCST
+4 IF BPCCTR=BPCMAX
SET BPCFLAG=1
+5 QUIT
STLIST(RESULT,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETSTATES
+1 SET U="^"
SET XWBWRAP=1
SET BPCSUB=$JOB
KILL ^BGURES(BPCSUB),RESULT
+2 SET RESULT="^BGURES("_BPCSUB_")"
+3 SET BPCX=$GET(BPCX)
SET BPCMAX=$GET(BPCMAX)
SET BPCMORE=$GET(BPCMORE)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
SET BPCCTR=0
SET BPCFLAG=0
+4 IF BPCX'=""
DO CKCXF
IF BPCFLAG
DO KILL
QUIT
+5 SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^DIC(5,"B",BPCX),-1)
+6 IF 'BPCMAX
SET BPCMAX=50
+7 IF BPCMORE'=""
DO MOREST
IF BPCFLAG
DO KILL
QUIT
+8 DO GETST
DO KILL
+9 QUIT
CKCXF ;
+1 IF $DATA(^DIC(5,"C",BPCX))=10
Begin DoDot:1
+2 SET BPCIEN=$ORDER(^DIC(5,"C",BPCX,""))
IF BPCIEN=""
QUIT
+3 SET ^BGURES(BPCSUB,0)=1
SET ^BGURES(BPCSUB,1)=BPCX_U_BPCIEN_U_$PIECE(^DIC(5,BPCIEN,0),U,1)
+4 SET BPCFLAG=1
End DoDot:1
QUIT
+5 QUIT
MOREST ;
+1 SET BPCCDE=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
+2 SET BPCN=$PIECE(BPCMORE,"|",3)
SET BPCCTR=BPCCTR+1
+3 SET ^BGURES(BPCSUB,BPCCTR)=BPCCDE_U_BPCIEN_U_BPCN
+4 IF BPCCTR=BPCMAX
SET BPCFLAG=1
+5 QUIT
GETST ;
+1 FOR
SET BPCN=$ORDER(^DIC(5,"B",BPCN))
IF BPCN=""
QUIT
Begin DoDot:1
+2 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+3 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^DIC(5,"B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
Begin DoDot:2
+4 SET BPCD=^DIC(5,BPCIEN,0)
SET BPCCDE=$PIECE(BPCD,U,2)
+5 IF BPCCTR=BPCMAX
Begin DoDot:3
+6 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)="..MORE"_U_BPCCDE_"|"_BPCIEN_"|"_BPCN
+7 SET BPCFLAG=1
End DoDot:3
QUIT
+8 SET BPCCTR=BPCCTR+1
SET ^BGURES(BPCSUB,BPCCTR)=BPCCDE_U_BPCIEN_U_BPCN
End DoDot:2
IF BPCFLAG
QUIT
End DoDot:1
IF BPCFLAG
QUIT
+9 SET ^BGURES(BPCSUB,0)=BPCCTR
+10 QUIT
