- 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
