BPCRC2 ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;
;;1.5;BPC;;MAY 26, 2005
;
RCISPARM(BPCRES,BPCSITE) ;EP CALL FROM REMOTE PROC: BPC GETRCISITEPARAM
;
EN2 ;
S XWBWRAP=1,BPCSITE=$G(BPCSITE)
I BPCSITE="" S BPCRES(1)=-1,BPCRES(2)="No Site ID Received!" D KILL Q
S BPCX=$G(^BMCPARM(BPCSITE,0))
I BPCX="" S BPCRES(1)=-1,BPCRES(2)="No RCIS Site Parameter Data Available!" D KILL Q
S BPCRES(1)=1,BPCRES(2)=BPCX
D KILL
Q
SCATLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETLOCALSERVICECAT
;
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:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10)
K ^BPCRES(BPCSUB)
I BPCX'="" I $D(^BMCLCAT("C",BPCX)) S BPCFLG=0 D GETSCAT I BPCFLG D KILL Q
S:BPCX'="" BPCN=$O(^BMCLCAT("B",BPCX),-1)
I BPCMORE'="" D MORESCAT,KILL Q
D GETSCAT1,KILL
Q
GETSCAT ;
S BPCIEN="" F S BPCIEN=$O(^BMCLCAT("C",BPCX,BPCIEN)) Q:BPCIEN="" S BPCN=$P($G(^BMCLCAT(BPCIEN,0)),U,1) D SETSCAT
S ^BPCRES(BPCSUB,0)=BPCCTR
S:BPCCTR BPCFLG=1
Q
GETSCAT1 ;
S BPCFLAG=0 F S BPCN=$O(^BMCLCAT("B",BPCN)) Q:BPCN="" D GETSCAT2 Q:BPCFLAG
S ^BPCRES(BPCSUB,0)=BPCCTR
Q
GETSCAT2 ;
I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
S BPCIEN="" F S BPCIEN=$O(^BMCLCAT("B",BPCN,BPCIEN)) Q:BPCIEN="" D SETSCAT Q:BPCFLAG
Q
SETSCAT ;
I BPCCTR=BPCMAX D SETMORE S BPCFLAG=1 Q
S BPCCTR=BPCCTR+1,^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
Q
MORESCAT ;
S BPCFLAG=0,BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2) D SETSCAT Q:BPCFLAG
F S BPCIEN=$O(^BMCLCAT("B",BPCN,BPCIEN)) Q:BPCIEN="" D SETSCAT Q:BPCFLAG
Q:BPCFLAG
D GETSCAT1
Q
;
VNDLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETVENDORS
;
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:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10)
K ^BPCRES(BPCSUB)
I BPCX'="" I $D(^AUTTVNDR("C",BPCX)) S BPCFLG=0 D GETVNDR I BPCFLG D KILL Q
S:BPCX'="" BPCN=$O(^AUTTVNDR("B",BPCX),-1)
I BPCMORE'="" D MORE,KILL Q
D GETVNDR1,KILL
Q
GETVNDR ;
S BPCIEN="" F S BPCIEN=$O(^AUTTVNDR("C",BPCX,BPCIEN)) Q:BPCIEN="" S BPCN=$P($G(^AUTTVNDR(BPCIEN,0)),U,1) D SETRES
S ^BPCRES(BPCSUB,0)=BPCCTR
S:BPCCTR BPCFLG=1
Q
GETVNDR1 ;
S BPCFLAG=0 F S BPCN=$O(^AUTTVNDR("B",BPCN)) Q:BPCN="" D GETVNDR2 Q:BPCFLAG
S ^BPCRES(BPCSUB,0)=BPCCTR
Q
GETVNDR2 ;
I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q
S BPCIEN="" F S BPCIEN=$O(^AUTTVNDR("B",BPCN,BPCIEN)) Q:BPCIEN="" D SETRES Q:BPCFLAG
Q
SETRES ;
I BPCCTR=BPCMAX D SETMORE S BPCFLAG=1 Q
S BPCDTA=$G(^AUTTVNDR(BPCIEN,11)),BPCEIN=$P(BPCDTA,U,1)
S BPCCTR=BPCCTR+1,^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCEIN_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 SETRES Q:BPCFLAG
F S BPCIEN=$O(^AUTTVNDR("B",BPCN,BPCIEN)) Q:BPCIEN="" D SETRES Q:BPCFLAG
Q:BPCFLAG
D GETVNDR1
Q
KILL ;
K BPCSITE,BPCX,BPCGUI,BPCCTR,BPCSUB,BPCC,BPCMORE,BPCMAX,BPCPARAM,BPCLEN,BPCN,BPCIEN,BPCFLG,BPCFLAG,BPCDTA,BPCEIN
Q
BPCRC2 ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
RCISPARM(BPCRES,BPCSITE) ;EP CALL FROM REMOTE PROC: BPC GETRCISITEPARAM
+1 ;
EN2 ;
+1 SET XWBWRAP=1
SET BPCSITE=$GET(BPCSITE)
+2 IF BPCSITE=""
SET BPCRES(1)=-1
SET BPCRES(2)="No Site ID Received!"
DO KILL
QUIT
+3 SET BPCX=$GET(^BMCPARM(BPCSITE,0))
+4 IF BPCX=""
SET BPCRES(1)=-1
SET BPCRES(2)="No RCIS Site Parameter Data Available!"
DO KILL
QUIT
+5 SET BPCRES(1)=1
SET BPCRES(2)=BPCX
+6 DO KILL
+7 QUIT
SCATLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETLOCALSERVICECAT
+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=""
+3 IF 'BPCMAX
SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)
+4 KILL ^BPCRES(BPCSUB)
+5 IF BPCX'=""
IF $DATA(^BMCLCAT("C",BPCX))
SET BPCFLG=0
DO GETSCAT
IF BPCFLG
DO KILL
QUIT
+6 IF BPCX'=""
SET BPCN=$ORDER(^BMCLCAT("B",BPCX),-1)
+7 IF BPCMORE'=""
DO MORESCAT
DO KILL
QUIT
+8 DO GETSCAT1
DO KILL
+9 QUIT
GETSCAT ;
+1 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^BMCLCAT("C",BPCX,BPCIEN))
IF BPCIEN=""
QUIT
SET BPCN=$PIECE($GET(^BMCLCAT(BPCIEN,0)),U,1)
DO SETSCAT
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 IF BPCCTR
SET BPCFLG=1
+4 QUIT
GETSCAT1 ;
+1 SET BPCFLAG=0
FOR
SET BPCN=$ORDER(^BMCLCAT("B",BPCN))
IF BPCN=""
QUIT
DO GETSCAT2
IF BPCFLAG
QUIT
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 QUIT
GETSCAT2 ;
+1 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+2 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^BMCLCAT("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO SETSCAT
IF BPCFLAG
QUIT
+3 QUIT
SETSCAT ;
+1 IF BPCCTR=BPCMAX
DO SETMORE
SET BPCFLAG=1
QUIT
+2 SET BPCCTR=BPCCTR+1
SET ^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN
+3 QUIT
MORESCAT ;
+1 SET BPCFLAG=0
SET BPCN=$PIECE(BPCMORE,"|",1)
SET BPCIEN=$PIECE(BPCMORE,"|",2)
DO SETSCAT
IF BPCFLAG
QUIT
+2 FOR
SET BPCIEN=$ORDER(^BMCLCAT("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO SETSCAT
IF BPCFLAG
QUIT
+3 IF BPCFLAG
QUIT
+4 DO GETSCAT1
+5 QUIT
+6 ;
VNDLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETVENDORS
+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=""
+3 IF 'BPCMAX
SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)
+4 KILL ^BPCRES(BPCSUB)
+5 IF BPCX'=""
IF $DATA(^AUTTVNDR("C",BPCX))
SET BPCFLG=0
DO GETVNDR
IF BPCFLG
DO KILL
QUIT
+6 IF BPCX'=""
SET BPCN=$ORDER(^AUTTVNDR("B",BPCX),-1)
+7 IF BPCMORE'=""
DO MORE
DO KILL
QUIT
+8 DO GETVNDR1
DO KILL
+9 QUIT
GETVNDR ;
+1 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^AUTTVNDR("C",BPCX,BPCIEN))
IF BPCIEN=""
QUIT
SET BPCN=$PIECE($GET(^AUTTVNDR(BPCIEN,0)),U,1)
DO SETRES
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 IF BPCCTR
SET BPCFLG=1
+4 QUIT
GETVNDR1 ;
+1 SET BPCFLAG=0
FOR
SET BPCN=$ORDER(^AUTTVNDR("B",BPCN))
IF BPCN=""
QUIT
DO GETVNDR2
IF BPCFLAG
QUIT
+2 SET ^BPCRES(BPCSUB,0)=BPCCTR
+3 QUIT
GETVNDR2 ;
+1 IF BPCX'=""
IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX
SET BPCFLAG=1
QUIT
+2 SET BPCIEN=""
FOR
SET BPCIEN=$ORDER(^AUTTVNDR("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO SETRES
IF BPCFLAG
QUIT
+3 QUIT
SETRES ;
+1 IF BPCCTR=BPCMAX
DO SETMORE
SET BPCFLAG=1
QUIT
+2 SET BPCDTA=$GET(^AUTTVNDR(BPCIEN,11))
SET BPCEIN=$PIECE(BPCDTA,U,1)
+3 SET BPCCTR=BPCCTR+1
SET ^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCEIN_U_BPCIEN
+4 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 SETRES
IF BPCFLAG
QUIT
+2 FOR
SET BPCIEN=$ORDER(^AUTTVNDR("B",BPCN,BPCIEN))
IF BPCIEN=""
QUIT
DO SETRES
IF BPCFLAG
QUIT
+3 IF BPCFLAG
QUIT
+4 DO GETVNDR1
+5 QUIT
KILL ;
+1 KILL BPCSITE,BPCX,BPCGUI,BPCCTR,BPCSUB,BPCC,BPCMORE,BPCMAX,BPCPARAM,BPCLEN,BPCN,BPCIEN,BPCFLG,BPCFLAG,BPCDTA,BPCEIN
+2 QUIT
