BPCRC1.m

BPCRC1 ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;

 ;;1.5;BPC;;MAY 26, 2005

RPRVLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETRCISPROV

 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(^BMCLPRV("B",BPCX),-1)

 S:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10)

 K ^BPCRES(BPCSUB)

 I BPCMORE'="" D MORERPRV,KILL Q

 D GETPRV1,KILL

 Q

GETPRV1 ;

 S BPCFLAG=0 F  S BPCN=$O(^BMCLPRV("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(^BMCLPRV("B",BPCN,BPCIEN)) Q:BPCIEN=""  D SETRES Q:BPCFLAG

 Q

MORERPRV ;

 S BPCFLAG=0,BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2) D SETRES Q:BPCFLAG

 F  S BPCIEN=$O(^BMCLPRV("B",BPCN,BPCIEN)) Q:BPCIEN=""  D SETRES Q:BPCFLAG

 Q:BPCFLAG

 D GETPRV1

 Q

CLNLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETCLINLIST

 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(^DIC(40.7,"C",BPCX)) S BPCFLG=0 D GETCLN I BPCFLG D KILL Q

 S:BPCX'="" BPCN=$O(^DIC(40.7,"B",BPCX),-1)

 I BPCMORE'="" D MORECLN,KILL Q

 D GETCLN1,KILL

 Q

GETCLN ;

 S BPCIEN=$O(^DIC(40.7,"C",BPCX,""))

 I BPCIEN S ^BPCRES(BPCSUB,0)=1,^BPCRES(BPCSUB,1)=$P($G(^DIC(40.7,BPCIEN,0)),U,1)_U_BPCIEN,BPCFLG=1

 Q

GETCLN1 ;

 S BPCFLAG=0 F  S BPCN=$O(^DIC(40.7,"B",BPCN)) Q:BPCN=""  D GETCLN2 Q:BPCFLAG

 S ^BPCRES(BPCSUB,0)=BPCCTR

 Q

GETCLN2 ;

 I BPCX'="",$E(BPCN,1,BPCLEN)'=BPCX S BPCFLAG=1 Q

 S BPCIEN="" F  S BPCIEN=$O(^DIC(40.7,"B",BPCN,BPCIEN)) Q:BPCIEN=""  D SETRES Q:BPCFLAG

 Q

SETRES ;

 I BPCCTR=BPCMAX D SETMORE S BPCFLAG=1 Q

 S BPCCTR=BPCCTR+1,^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN

 Q

MORECLN ;

 S BPCFLAG=0,BPCN=$P(BPCMORE,"|",1),BPCIEN=$P(BPCMORE,"|",2) D SETRES Q:BPCFLAG

 F  S BPCIEN=$O(^DIC(40.7,"B",BPCN,BPCIEN)) Q:BPCIEN=""  D SETRES Q:BPCFLAG

 Q:BPCFLAG

 D GETCLN1

 Q

 ;

REFLIST(BPCRES,BPCIEN,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETREFERRALS

 ;POSSIBLE RETURN VALUES

 ; Regular String: (DELIMITED BY "^")

 ; 1. Referral IEN

 ; 2. Referral #

 ; 3. Purpose

 ; 4. Provider Name

 ; 5. Provider IEN

 ; 6. Initiated Date (internal)

 ; 7. Estimated Service Date (internal)

 ; 8. Actual Service Date (internal)

 ; (More to be added)

 ;More String: (DELIMITED BY "|")

 ; 1. "..MORE"

 ; 2. Last Referral IEN

 ; 3. Patient IEN

 ;

 S BPCGUI=1

EN ;

 S U="^",XWBWRAP=1,BPCCTR=0,BPCSUB=$J,BPCC="",BPCMORE=$G(BPCMORE),BPCGUI=$G(BPCGUI),BPCMAX=$G(BPCMAX),BPCPARAM=$G(BPCPARAM),BPCN=""

 S BPCRES="^BPCRES("_BPCSUB_")"

 S:'BPCMAX BPCMAX=$S(BPCGUI:50,1:1E10)

 K ^BPCRES(BPCSUB)

 I BPCIEN="" S ^BPCRES(BPCSUB,0)=-1,^BPCRES(BPCSUB,1)="NO PATIENT IEN SENT WITH REQUEST!"  D KILL Q

 I BPCMORE'="" D MORE,KILL Q

 D GETRES1,KILL

 Q

GETRES1 ;

 I $D(^BMCREF("D",BPCIEN)) S BPCFLAG=0 F  S BPCN=$O(^BMCREF("D",BPCIEN,BPCN),-1) Q:BPCN=""  D GETRES2 Q:BPCFLAG

 S ^BPCRES(BPCSUB,0)=BPCCTR

 Q

GETRES2 ;

 I BPCCTR=BPCMAX D SETMORE S BPCFLAG=1 Q

 S BPCDTA=^BMCREF(BPCN,0),BPCIDATE=$P(BPCDTA,U,1),BPCRNUM=$P(BPCDTA,U,2),BPCPURP=$P($G(^BMCREF(BPCN,12)),U,1),BPCPIEN=$P(BPCDTA,U,6)

 S:BPCPIEN BPCPNAM=$P(^VA(200,BPCPIEN,0),U,1)

 I 'BPCPIEN S BPCPNAM="NO PROVIDER INDICATED"

 S BPCIDAT=$P(BPCDTA,U,1),BPCDTA=$G(^BMCREF(BPCN,11)),BPCEDAT=$P(BPCDTA,U,5),BPCADAT=$P(BPCDTA,U,6)

 S BPCDTA=BPCN_U_BPCRNUM_U_BPCPURP_U_BPCPNAM_U_BPCPIEN_U_BPCIDAT_U_BPCEDAT_U_BPCADAT

 S BPCCTR=BPCCTR+1,^BPCRES(BPCSUB,BPCCTR)=BPCDTA

 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 GETRES2 Q:BPCFLAG

 D GETRES1

 Q

KILL ;

 K BPCX,BPCMAX,BPCMORE,BPCPARAM,BPCGUI,BPCCTR,BPCSUB,BPCC,BPCLEN,BPCN,BPCFLAG,BPCIEN,BPCFLG,BPCDTA,BPCIDATE,BPCRNUM,BPCPURP,BPCPIEN,BPCPNAM,BPCEDAT,BPCADAT

 Q

BPCRC1    ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;

 +1       ;;1.5;BPC;;MAY 26, 2005

RPRVLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETRCISPROV

 +1        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=""

 +3        IF BPCX'=""

               SET BPCN=$ORDER(^BMCLPRV("B",BPCX),-1)

 +4        IF 'BPCMAX

               SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)

 +5        KILL ^BPCRES(BPCSUB)

 +6        IF BPCMORE'=""

               DO MORERPRV

               DO KILL

               QUIT 

 +7        DO GETPRV1

           DO KILL

 +8        QUIT 

GETPRV1   ;

 +1        SET BPCFLAG=0

           FOR 

               SET BPCN=$ORDER(^BMCLPRV("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(^BMCLPRV("B",BPCN,BPCIEN))

               IF BPCIEN=""

                   QUIT 

               DO SETRES

               IF BPCFLAG

                   QUIT 

 +3        QUIT 

MORERPRV  ;

 +1        SET BPCFLAG=0

           SET BPCN=$PIECE(BPCMORE,"|",1)

           SET BPCIEN=$PIECE(BPCMORE,"|",2)

           DO SETRES

           IF BPCFLAG

               QUIT 

 +2        FOR 

               SET BPCIEN=$ORDER(^BMCLPRV("B",BPCN,BPCIEN))

               IF BPCIEN=""

                   QUIT 

               DO SETRES

               IF BPCFLAG

                   QUIT 

 +3        IF BPCFLAG

               QUIT 

 +4        DO GETPRV1

 +5        QUIT 

CLNLIST(BPCRES,BPCX,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETCLINLIST

 +1        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(^DIC(40.7,"C",BPCX))

                   SET BPCFLG=0

                   DO GETCLN

                   IF BPCFLG

                       DO KILL

                       QUIT 

 +6        IF BPCX'=""

               SET BPCN=$ORDER(^DIC(40.7,"B",BPCX),-1)

 +7        IF BPCMORE'=""

               DO MORECLN

               DO KILL

               QUIT 

 +8        DO GETCLN1

           DO KILL

 +9        QUIT 

GETCLN    ;

 +1        SET BPCIEN=$ORDER(^DIC(40.7,"C",BPCX,""))

 +2        IF BPCIEN

               SET ^BPCRES(BPCSUB,0)=1

               SET ^BPCRES(BPCSUB,1)=$PIECE($GET(^DIC(40.7,BPCIEN,0)),U,1)_U_BPCIEN

               SET BPCFLG=1

 +3        QUIT 

GETCLN1   ;

 +1        SET BPCFLAG=0

           FOR 

               SET BPCN=$ORDER(^DIC(40.7,"B",BPCN))

               IF BPCN=""

                   QUIT 

               DO GETCLN2

               IF BPCFLAG

                   QUIT 

 +2        SET ^BPCRES(BPCSUB,0)=BPCCTR

 +3        QUIT 

GETCLN2   ;

 +1        IF BPCX'=""

               IF $EXTRACT(BPCN,1,BPCLEN)'=BPCX

                   SET BPCFLAG=1

                   QUIT 

 +2        SET BPCIEN=""

           FOR 

               SET BPCIEN=$ORDER(^DIC(40.7,"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 BPCCTR=BPCCTR+1

           SET ^BPCRES(BPCSUB,BPCCTR)=BPCN_U_BPCIEN

 +3        QUIT 

MORECLN   ;

 +1        SET BPCFLAG=0

           SET BPCN=$PIECE(BPCMORE,"|",1)

           SET BPCIEN=$PIECE(BPCMORE,"|",2)

           DO SETRES

           IF BPCFLAG

               QUIT 

 +2        FOR 

               SET BPCIEN=$ORDER(^DIC(40.7,"B",BPCN,BPCIEN))

               IF BPCIEN=""

                   QUIT 

               DO SETRES

               IF BPCFLAG

                   QUIT 

 +3        IF BPCFLAG

               QUIT 

 +4        DO GETCLN1

 +5        QUIT 

 +6       ;

REFLIST(BPCRES,BPCIEN,BPCMAX,BPCMORE,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETREFERRALS

 +1       ;POSSIBLE RETURN VALUES

 +2       ; Regular String: (DELIMITED BY "^")

 +3       ; 1. Referral IEN

 +4       ; 2. Referral #

 +5       ; 3. Purpose

 +6       ; 4. Provider Name

 +7       ; 5. Provider IEN

 +8       ; 6. Initiated Date (internal)

 +9       ; 7. Estimated Service Date (internal)

 +10      ; 8. Actual Service Date (internal)

 +11      ; (More to be added)

 +12      ;More String: (DELIMITED BY "|")

 +13      ; 1. "..MORE"

 +14      ; 2. Last Referral IEN

 +15      ; 3. Patient IEN

 +16      ;

 +17       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 BPCPARAM=$GET(BPCPARAM)

           SET BPCN=""

 +2        SET BPCRES="^BPCRES("_BPCSUB_")"

 +3        IF 'BPCMAX

               SET BPCMAX=$SELECT(BPCGUI:50,1:1E10)

 +4        KILL ^BPCRES(BPCSUB)

 +5        IF BPCIEN=""

               SET ^BPCRES(BPCSUB,0)=-1

               SET ^BPCRES(BPCSUB,1)="NO PATIENT IEN SENT WITH REQUEST!"

               DO KILL

               QUIT 

 +6        IF BPCMORE'=""

               DO MORE

               DO KILL

               QUIT 

 +7        DO GETRES1

           DO KILL

 +8        QUIT 

GETRES1   ;

 +1        IF $DATA(^BMCREF("D",BPCIEN))

               SET BPCFLAG=0

               FOR 

                   SET BPCN=$ORDER(^BMCREF("D",BPCIEN,BPCN),-1)

                   IF BPCN=""

                       QUIT 

                   DO GETRES2

                   IF BPCFLAG

                       QUIT 

 +2        SET ^BPCRES(BPCSUB,0)=BPCCTR

 +3        QUIT 

GETRES2   ;

 +1        IF BPCCTR=BPCMAX

               DO SETMORE

               SET BPCFLAG=1

               QUIT 

 +2        SET BPCDTA=^BMCREF(BPCN,0)

           SET BPCIDATE=$PIECE(BPCDTA,U,1)

           SET BPCRNUM=$PIECE(BPCDTA,U,2)

           SET BPCPURP=$PIECE($GET(^BMCREF(BPCN,12)),U,1)

           SET BPCPIEN=$PIECE(BPCDTA,U,6)

 +3        IF BPCPIEN

               SET BPCPNAM=$PIECE(^VA(200,BPCPIEN,0),U,1)

 +4        IF 'BPCPIEN

               SET BPCPNAM="NO PROVIDER INDICATED"

 +5        SET BPCIDAT=$PIECE(BPCDTA,U,1)

           SET BPCDTA=$GET(^BMCREF(BPCN,11))

           SET BPCEDAT=$PIECE(BPCDTA,U,5)

           SET BPCADAT=$PIECE(BPCDTA,U,6)

 +6        SET BPCDTA=BPCN_U_BPCRNUM_U_BPCPURP_U_BPCPNAM_U_BPCPIEN_U_BPCIDAT_U_BPCEDAT_U_BPCADAT

 +7        SET BPCCTR=BPCCTR+1

           SET ^BPCRES(BPCSUB,BPCCTR)=BPCDTA

 +8        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 GETRES2

           IF BPCFLAG

               QUIT 

 +2        DO GETRES1

 +3        QUIT 

KILL      ;

 +1        KILL BPCX,BPCMAX,BPCMORE,BPCPARAM,BPCGUI,BPCCTR,BPCSUB,BPCC,BPCLEN,BPCN,BPCFLAG,BPCIEN,BPCFLG,BPCDTA,BPCIDATE,BPCRNUM,BPCPURP,BPCPIEN,BPCPNAM,BPCEDAT,BPCADAT

 +2        QUIT