BPCRC ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;
;;1.5;BPC;;MAY 26, 2005
CPTLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETCPTCATS
;
S BPCGUI=1
EN3 ;
S U="^",XWBWRAP=1,BPCCTR=0,BPCSUB=$J,BPCC="",BPCMORE=$G(BPCMORE),BPCGUI=$G(BPCGUI),BPCMAX=$G(BPCMAX),BPCX=$G(BPCX),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX)
S BPCRES="^BPCRES("_BPCSUB_")",BPCN="" S:BPCX'="" BPCN=$O(^BMCTSVC("B",BPCX),-1)
S:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10) ;
K ^BPCRES(BPCSUB)
I BPCMORE'="" D MORECPT,KILL Q
D GETCPT1,KILL
Q
GETCPT1 ;
S BPCFLAG=0 F S BPCN=$O(^BMCTSVC("B",BPCN)) Q:BPCN="" D GETCPT2 Q:BPCFLAG
S ^BPCRES(BPCSUB,0)=BPCCTR
Q
GETCPT2 ;
I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
S BPCIEN="" F S BPCIEN=$O(^BMCTSVC("B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q
MORECPT ;
S BPCFLAG=0,BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2) D GETRES3 Q:BPCFLAG
F S BPCIEN=$O(^BMCTSVC("B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q:BPCFLAG
D GETCPT1
Q
ICDLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETICDCATS
;
S BPCGUI=1
EN2 ;
S U="^",XWBWRAP=1,BPCCTR=0,BPCSUB=$J,BPCC="",BPCMORE=$G(BPCMORE),BPCGUI=$G(BPCGUI),BPCMAX=$G(BPCMAX),BPCX=$G(BPCX),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX)
S BPCRES="^BPCRES("_BPCSUB_")",BPCN="" S:BPCX'="" BPCN=$O(^BMCTDXC("B",BPCX),-1)
S:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10) ;
K ^BPCRES(BPCSUB)
I BPCMORE'="" D MOREICD,KILL Q
D GETICD1,KILL
Q
GETICD1 ;
S BPCFLAG=0 F S BPCN=$O(^BMCTDXC("B",BPCN)) Q:BPCN="" D GETICD2 Q:BPCFLAG
S ^BPCRES(BPCSUB,0)=BPCCTR
Q
GETICD2 ;
I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
S BPCIEN="" F S BPCIEN=$O(^BMCTDXC("B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q
MOREICD ;
S BPCFLAG=0,BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2) D GETRES3 Q:BPCFLAG
F S BPCIEN=$O(^BMCTDXC("B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q:BPCFLAG
D GETICD1
Q
PRVLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETPROVIDERS
;
S BPCGUI=1
EN1 ;
S U="^",XWBWRAP=1,BPCCTR=0,BPCSUB=$J,BPCC="",BPCMORE=$G(BPCMORE),BPCGUI=$G(BPCGUI),BPCMAX=$G(BPCMAX),BPCX=$G(BPCX),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX)
S BPCRES="^BPCRES("_BPCSUB_")",BPCN="" S:BPCX'="" BPCN=$O(^VA(200,"B",BPCX),-1)
S:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10) ;
K ^BPCRES(BPCSUB)
I BPCMORE'="" D MOREPRV,KILL Q
D GETPRV1,KILL
Q
GETPRV1 ;
S BPCFLAG=0 F S BPCN=$O(^VA(200,"B",BPCN)) Q:BPCN="" D GETPRV2 Q:BPCFLAG
S ^BPCRES(BPCSUB,0)=BPCCTR
Q
GETPRV2 ;
I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
S BPCIEN="" F S BPCIEN=$O(^VA(200,"B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q
MOREPRV ;
S BPCFLAG=0,BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2) D GETRES3 Q:BPCFLAG
F S BPCIEN=$O(^VA(200,"B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q:BPCFLAG
D GETPRV1
Q
LOCLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETLOCATIONS
;
S BPCGUI=1
EN ;
S U="^",XWBWRAP=1,BPCCTR=0,BPCSUB=$J,BPCC="",BPCMORE=$G(BPCMORE),BPCGUI=$G(BPCGUI),BPCMAX=$G(BPCMAX),BPCX=$G(BPCX),BPCPARAM=$G(BPCPARAM),BPCLEN=$L(BPCX)
S BPCRES="^BPCRES("_BPCSUB_")",BPCN="" S:BPCX'="" BPCN=$O(^DIC(4,"B",BPCX),-1)
S:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10) ;
K ^BPCRES(BPCSUB)
I BPCMORE'="" D MORE,KILL Q
D GETRES1,KILL
Q
GETRES1 ;
S BPCFLAG=0 F S BPCN=$O(^DIC(4,"B",BPCN)) Q:BPCN="" D GETRES2 Q:BPCFLAG
S ^BPCRES(BPCSUB,0)=BPCCTR
Q
GETRES2 ;
I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
S BPCIEN="" F S BPCIEN=$O(^DIC(4,"B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q
GETRES3 ;
I BPCCTR=BPCMAX D SETMORE S BPCFLAG=1 Q
S BPCCTR=BPCCTR+1,^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
Q
SETMORE ;
S BPCCTR=BPCCTR+1,^BPCRES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN
Q
MORE ;
S BPCFLAG=0,BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2) D GETRES3 Q:BPCFLAG
F S BPCIEN=$O(^DIC(4,"B",BPCN,BPCIEN)) Q:BPCIEN="" D GETRES3 Q:BPCFLAG
Q:BPCFLAG
D GETRES1
Q
;
KILL ;
K BPCC,BPCCTR,BPCFLAG,BPCGUI,BPCIEN,BPCLEN,BPCMAX,BPCMORE,BPCN,BPCPARAM,BPCSUB,BPCX
Q
BPCRC ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;
+1 ;;1.5;BPC;;MAY 26, 2005
CPTLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETCPTCATS
+1 ;
+2 SET BPCGUI=1
EN3 ;
+1 SET U="^"
SET XWBWRAP=1
SET BPCCTR=0
SET BPCSUB=$JOB
SET BPCC=""
SET BPCMORE=$GET(BPCMORE)
SET BPCGUI=$GET(BPCGUI)
SET BPCMAX=$GET(BPCMAX)
SET BPCX=$GET(BPCX)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
+2 SET BPCRES="^BPCRES("_BPCSUB_")"
SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^BMCTSVC("B",BPCX),-1)
+3 ;
IF 'BPCMAX
SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)
+4 KILL ^BPCRES(BPCSUB)
+5 IF BPCMORE'=""
DO MORECPT
DO KILL
QUIT
+6 DO GETCPT1
DO KILL
+7 QUIT
GETCPT1 ;
+1 SET BPCFLAG=0
FOR
SET BPCN=$ORDER(^BMCTSVC("B",BPCN))
IF BPCN=""
QUIT
DO GETCPT2
IF BPCFLAG
QUIT
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 QUIT
GETCPT2 ;
+1 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+2 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^BMCTSVC("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 QUIT
MORECPT ;
+1 SET BPCFLAG=0
SET BPCN=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
DO GETRES3
IF BPCFLAG
QUIT
+2 FOR
SET BPCIEN=$ORDER(^BMCTSVC("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 IF BPCFLAG
QUIT
+4 DO GETCPT1
+5 QUIT
ICDLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETICDCATS
+1 ;
+2 SET BPCGUI=1
EN2 ;
+1 SET U="^"
SET XWBWRAP=1
SET BPCCTR=0
SET BPCSUB=$JOB
SET BPCC=""
SET BPCMORE=$GET(BPCMORE)
SET BPCGUI=$GET(BPCGUI)
SET BPCMAX=$GET(BPCMAX)
SET BPCX=$GET(BPCX)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
+2 SET BPCRES="^BPCRES("_BPCSUB_")"
SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^BMCTDXC("B",BPCX),-1)
+3 ;
IF 'BPCMAX
SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)
+4 KILL ^BPCRES(BPCSUB)
+5 IF BPCMORE'=""
DO MOREICD
DO KILL
QUIT
+6 DO GETICD1
DO KILL
+7 QUIT
GETICD1 ;
+1 SET BPCFLAG=0
FOR
SET BPCN=$ORDER(^BMCTDXC("B",BPCN))
IF BPCN=""
QUIT
DO GETICD2
IF BPCFLAG
QUIT
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 QUIT
GETICD2 ;
+1 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+2 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^BMCTDXC("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 QUIT
MOREICD ;
+1 SET BPCFLAG=0
SET BPCN=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
DO GETRES3
IF BPCFLAG
QUIT
+2 FOR
SET BPCIEN=$ORDER(^BMCTDXC("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 IF BPCFLAG
QUIT
+4 DO GETICD1
+5 QUIT
PRVLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETPROVIDERS
+1 ;
+2 SET BPCGUI=1
EN1 ;
+1 SET U="^"
SET XWBWRAP=1
SET BPCCTR=0
SET BPCSUB=$JOB
SET BPCC=""
SET BPCMORE=$GET(BPCMORE)
SET BPCGUI=$GET(BPCGUI)
SET BPCMAX=$GET(BPCMAX)
SET BPCX=$GET(BPCX)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
+2 SET BPCRES="^BPCRES("_BPCSUB_")"
SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^VA(200,"B",BPCX),-1)
+3 ;
IF 'BPCMAX
SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)
+4 KILL ^BPCRES(BPCSUB)
+5 IF BPCMORE'=""
DO MOREPRV
DO KILL
QUIT
+6 DO GETPRV1
DO KILL
+7 QUIT
GETPRV1 ;
+1 SET BPCFLAG=0
FOR
SET BPCN=$ORDER(^VA(200,"B",BPCN))
IF BPCN=""
QUIT
DO GETPRV2
IF BPCFLAG
QUIT
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 QUIT
GETPRV2 ;
+1 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+2 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^VA(200,"B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 QUIT
MOREPRV ;
+1 SET BPCFLAG=0
SET BPCN=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
DO GETRES3
IF BPCFLAG
QUIT
+2 FOR
SET BPCIEN=$ORDER(^VA(200,"B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 IF BPCFLAG
QUIT
+4 DO GETPRV1
+5 QUIT
LOCLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETLOCATIONS
+1 ;
+2 SET BPCGUI=1
EN ;
+1 SET U="^"
SET XWBWRAP=1
SET BPCCTR=0
SET BPCSUB=$JOB
SET BPCC=""
SET BPCMORE=$GET(BPCMORE)
SET BPCGUI=$GET(BPCGUI)
SET BPCMAX=$GET(BPCMAX)
SET BPCX=$GET(BPCX)
SET BPCPARAM=$GET(BPCPARAM)
SET BPCLEN=$LENGTH(BPCX)
+2 SET BPCRES="^BPCRES("_BPCSUB_")"
SET BPCN=""
IF BPCX'=""
SET BPCN=$ORDER(^DIC(4,"B",BPCX),-1)
+3 ;
IF 'BPCMAX
SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)
+4 KILL ^BPCRES(BPCSUB)
+5 IF BPCMORE'=""
DO MORE
DO KILL
QUIT
+6 DO GETRES1
DO KILL
+7 QUIT
GETRES1 ;
+1 SET BPCFLAG=0
FOR
SET BPCN=$ORDER(^DIC(4,"B",BPCN))
IF BPCN=""
QUIT
DO GETRES2
IF BPCFLAG
QUIT
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 QUIT
GETRES2 ;
+1 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+2 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^DIC(4,"B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 QUIT
GETRES3 ;
+1 IF BPCCTR=BPCMAX
DO SETMORE
SET BPCFLAG=1
QUIT
+2 SET BPCCTR=BPCCTR+1
SET ^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
+3 QUIT
SETMORE ;
+1 SET BPCCTR=BPCCTR+1
SET ^BPCRES(BPCSUB,BPCCTR)="..MORE"_U_BPCN_"|"_BPCIEN
+2 QUIT
MORE ;
+1 SET BPCFLAG=0
SET BPCN=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
DO GETRES3
IF BPCFLAG
QUIT
+2 FOR
SET BPCIEN=$ORDER(^DIC(4,"B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO GETRES3
IF BPCFLAG
QUIT
+3 IF BPCFLAG
QUIT
+4 DO GETRES1
+5 QUIT
+6 ;
KILL ;
+1 KILL BPCC,BPCCTR,BPCFLAG,BPCGUI,BPCIEN,BPCLEN,BPCMAX,BPCMORE,BPCN,BPCPARAM,BPCSUB,BPCX
+2 QUIT
