BPCRC.m

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