BEHOPTPC ;MSC/IND/DKM - RPC calls for provider information ;16-Apr-2013 14:35;DU
;;1.1;BEH COMPONENTS;**004004,004009**;Mar 20, 2007
;=================================================================
USESD() Q $G(DUZ("AG"))'="I"
; Get the primary provider
OUTPTPR(DFN) ;EP
Q:$$USESD $$OUTPTPR^SDUTL3(DFN)
N PCP
S PCP=$$GET1^DIQ(9000001,DFN,.14,"I")
Q $S(PCP:PCP_U_$P(^VA(200,PCP,0),U),1:"")
; Get team
OUTPTTM(DFN) ;EP
Q:$$USESD $$OUTPTTM^SDUTL3(DFN)
N TM
S TM=$O(^BSDPCT("AB",+$$OUTPTPR(DFN),0))
Q $S(TM:TM_U_$$GET1^DIQ(9009017.5,TM,.01),1:"")
; Return Primary Care Detail information
DETAIL(DATA,DFN) ;EP
I $$USESD D
.N I,X
.S X=$$OUTPTTM^SDUTL3(DFN,DT),I=0
.I X>0 D
..D ADDDET($P(X,U,2),"Primary Care Team")
..D ADDDET($P($G(^SCTM(404.51,+X,0)),U,2),"Phone")
.E D ADDDET("No Primary Care Team Assigned.")
.D ADDPRV("Primary Care Provider",+$$OUTPTPR^SDUTL3(DFN,DT))
.D ADDPRV("Associate Provider",+$$OUTPTAP^SDUTL3(DFN,DT))
.D ADDPRV("Attending Physician",+$G(^DPT(DFN,.1041)),1)
E D
.N I,X,BDPQ,BDPTYPE,BDPCOUNT,BDPRIEN,BDPTYPNM,BDPCPRV
.S I=0
.D ADDDET("**CURRENT DESIGNATED PROVIDERS - BY PROVIDER CATEGORY TYPE**")
.I '$D(^BDPRECN("AA",DFN)) D ADDDET("**--NO EXISTING DESIGNATED PROVIDERS--**") Q
.S BDPQ=0,BDPTYPE="",BDPCOUNT=0
.F S BDPTYPE=$O(^BDPRECN("AA",DFN,BDPTYPE)) Q:BDPTYPE="" D
..S BDPCOUNT=BDPCOUNT+1,BDPRIEN=""
..S BDPTYPNM=$P(^BDPTCAT(BDPTYPE,0),U) ;Type Print
..F S BDPRIEN=$O(^BDPRECN("AA",DFN,BDPTYPE,BDPRIEN)) Q:BDPRIEN'=+BDPRIEN D
...S BDPCPRV=+$P($G(^BDPRECN(BDPRIEN,0)),U,3)
...Q:'+BDPCPRV
...;Current Provider IEN
...;S BDPCPRVP=$S(BDPCPRV:$P($G(^VA(200,BDPCPRV,0)),U),1:"<None Currently Assigned>")
...S BDPCPRVP=$P($G(^VA(200,BDPCPRV,0)),U)
...D ADDDET(BDPCOUNT_" "_$$LJ^XLFSTR($E(BDPTYPNM,1,30),30)_": "_$$LJ^XLFSTR($E(BDPCPRVP,1,35),45))
Q
ADDDET(TXT,LBL) ;
Q:'$L($G(TXT))
S:$D(LBL) TXT=$$RJ^XLFSTR(LBL,21)_": "_TXT
S DATA(I)=TXT,I=I+1
Q
ADDPRV(TYP,PRV,FLG) ;
D ADDDET(" ")
I $D(^VA(200,PRV,0)) D
.N X
.D ADDDET($P(^VA(200,PRV,0),U),TYP)
.S X=$G(^VA(200,PRV,.13))
.D ADDDET($P(X,U,7),"Analog Pager")
.D ADDDET($P(X,U,8),"Digital Pager")
.D ADDDET($P(X,U,2),"Office Phone")
E D:'$G(FLG) ADDDET("No "_TYP_" Assigned.")
Q
; Find all providers on the team associated with the primary provider
TEAM(BEHODUZ) ;EP
N BEHOX,BEHOY,BEHOTM,BEHOCT
K ^TMP("ORIHS",$J)
;BEHOX is the team of the primary provider
S BEHOCT=0,BEHOX=$O(^BSDPCT("AB",BEHODUZ,0)),BEHOY=0
Q:'BEHOX
F S BEHOY=$O(^BSDPCT(BEHOX,1,BEHOY)) Q:BEHOY="" D
.S BEHOTM=$P($G(^BSDPCT(BEHOX,1,BEHOY,0)),U)
.S:BEHOTM'="" ^TMP("ORIHS",$J,BEHOTM)=""
Q
GETBDP(RET,DFN) ;RPC to get all designated providers for a patient
N ARRAY,CNT
D ALLDP^BDPAPI(DFN,"",.ARRAY)
S CNT=0
S TYP="" F S TYP=$O(ARRAY(TYP)) Q:TYP="" D
.S TXT=$G(ARRAY(TYP))
.I TXT'="" D
..S CNT=CNT+1
..S RET(CNT)=TYP_U_TXT
Q
SETBDP(RET,DFN,TYPE,PROV) ;RPC to add/edit/delete a provider for a category
D AEDAP^BDPAPI(DFN,PROV,TYPE,.RET)
Q
GETCATS(LIST) ;Return the list of categories
N CAT,CNT
S CNT=0
S CAT="" F S CAT=$O(^BDPTCAT("B",CAT)) Q:CAT="" D
.S CNT=CNT+1
.S LIST(CNT)=CAT
Q
BEHOPTPC ;MSC/IND/DKM - RPC calls for provider information ;16-Apr-2013 14:35;DU
+1 ;;1.1;BEH COMPONENTS;**004004,004009**;Mar 20, 2007
+2 ;=================================================================
USESD() QUIT $GET(DUZ("AG"))'="I"
+1 ; Get the primary provider
OUTPTPR(DFN) ;EP
+1 IF $$USESD
QUIT $$OUTPTPR^SDUTL3(DFN)
+2 NEW PCP
+3 SET PCP=$$GET1^DIQ(9000001,DFN,.14,"I")
+4 QUIT $SELECT(PCP:PCP_U_$PIECE(^VA(200,PCP,0),U),1:"")
+5 ; Get team
OUTPTTM(DFN) ;EP
+1 IF $$USESD
QUIT $$OUTPTTM^SDUTL3(DFN)
+2 NEW TM
+3 SET TM=$ORDER(^BSDPCT("AB",+$$OUTPTPR(DFN),0))
+4 QUIT $SELECT(TM:TM_U_$$GET1^DIQ(9009017.5,TM,.01),1:"")
+5 ; Return Primary Care Detail information
DETAIL(DATA,DFN) ;EP
+1 IF $$USESD
Begin DoDot:1
+2 NEW I,X
+3 SET X=$$OUTPTTM^SDUTL3(DFN,DT)
SET I=0
+4 IF X>0
Begin DoDot:2
+5 DO ADDDET($PIECE(X,U,2),"Primary Care Team")
+6 DO ADDDET($PIECE($GET(^SCTM(404.51,+X,0)),U,2),"Phone")
End DoDot:2
+7 IF '$TEST
DO ADDDET("No Primary Care Team Assigned.")
+8 DO ADDPRV("Primary Care Provider",+$$OUTPTPR^SDUTL3(DFN,DT))
+9 DO ADDPRV("Associate Provider",+$$OUTPTAP^SDUTL3(DFN,DT))
+10 DO ADDPRV("Attending Physician",+$GET(^DPT(DFN,.1041)),1)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 NEW I,X,BDPQ,BDPTYPE,BDPCOUNT,BDPRIEN,BDPTYPNM,BDPCPRV
+13 SET I=0
+14 DO ADDDET("**CURRENT DESIGNATED PROVIDERS - BY PROVIDER CATEGORY TYPE**")
+15 IF '$DATA(^BDPRECN("AA",DFN))
DO ADDDET("**--NO EXISTING DESIGNATED PROVIDERS--**")
QUIT
+16 SET BDPQ=0
SET BDPTYPE=""
SET BDPCOUNT=0
+17 FOR
SET BDPTYPE=$ORDER(^BDPRECN("AA",DFN,BDPTYPE))
IF BDPTYPE=""
QUIT
Begin DoDot:2
+18 SET BDPCOUNT=BDPCOUNT+1
SET BDPRIEN=""
+19 ;Type Print
SET BDPTYPNM=$PIECE(^BDPTCAT(BDPTYPE,0),U)
+20 FOR
SET BDPRIEN=$ORDER(^BDPRECN("AA",DFN,BDPTYPE,BDPRIEN))
IF BDPRIEN'=+BDPRIEN
QUIT
Begin DoDot:3
+21 SET BDPCPRV=+$PIECE($GET(^BDPRECN(BDPRIEN,0)),U,3)
+22 IF '+BDPCPRV
QUIT
+23 ;Current Provider IEN
+24 ;S BDPCPRVP=$S(BDPCPRV:$P($G(^VA(200,BDPCPRV,0)),U),1:"<None Currently Assigned>")
+25 SET BDPCPRVP=$PIECE($GET(^VA(200,BDPCPRV,0)),U)
+26 DO ADDDET(BDPCOUNT_" "_$$LJ^XLFSTR($EXTRACT(BDPTYPNM,1,30),30)_": "_$$LJ^XLFSTR($EXTRACT(BDPCPRVP,1,35),45))
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT
ADDDET(TXT,LBL) ;
+1 IF '$LENGTH($GET(TXT))
QUIT
+2 IF $DATA(LBL)
SET TXT=$$RJ^XLFSTR(LBL,21)_": "_TXT
+3 SET DATA(I)=TXT
SET I=I+1
+4 QUIT
ADDPRV(TYP,PRV,FLG) ;
+1 DO ADDDET(" ")
+2 IF $DATA(^VA(200,PRV,0))
Begin DoDot:1
+3 NEW X
+4 DO ADDDET($PIECE(^VA(200,PRV,0),U),TYP)
+5 SET X=$GET(^VA(200,PRV,.13))
+6 DO ADDDET($PIECE(X,U,7),"Analog Pager")
+7 DO ADDDET($PIECE(X,U,8),"Digital Pager")
+8 DO ADDDET($PIECE(X,U,2),"Office Phone")
End DoDot:1
+9 IF '$TEST
IF '$GET(FLG)
DO ADDDET("No "_TYP_" Assigned.")
+10 QUIT
+11 ; Find all providers on the team associated with the primary provider
TEAM(BEHODUZ) ;EP
+1 NEW BEHOX,BEHOY,BEHOTM,BEHOCT
+2 KILL ^TMP("ORIHS",$JOB)
+3 ;BEHOX is the team of the primary provider
+4 SET BEHOCT=0
SET BEHOX=$ORDER(^BSDPCT("AB",BEHODUZ,0))
SET BEHOY=0
+5 IF 'BEHOX
QUIT
+6 FOR
SET BEHOY=$ORDER(^BSDPCT(BEHOX,1,BEHOY))
IF BEHOY=""
QUIT
Begin DoDot:1
+7 SET BEHOTM=$PIECE($GET(^BSDPCT(BEHOX,1,BEHOY,0)),U)
+8 IF BEHOTM'=""
SET ^TMP("ORIHS",$JOB,BEHOTM)=""
End DoDot:1
+9 QUIT
GETBDP(RET,DFN) ;RPC to get all designated providers for a patient
+1 NEW ARRAY,CNT
+2 DO ALLDP^BDPAPI(DFN,"",.ARRAY)
+3 SET CNT=0
+4 SET TYP=""
FOR
SET TYP=$ORDER(ARRAY(TYP))
IF TYP=""
QUIT
Begin DoDot:1
+5 SET TXT=$GET(ARRAY(TYP))
+6 IF TXT'=""
Begin DoDot:2
+7 SET CNT=CNT+1
+8 SET RET(CNT)=TYP_U_TXT
End DoDot:2
End DoDot:1
+9 QUIT
SETBDP(RET,DFN,TYPE,PROV) ;RPC to add/edit/delete a provider for a category
+1 DO AEDAP^BDPAPI(DFN,PROV,TYPE,.RET)
+2 QUIT
GETCATS(LIST) ;Return the list of categories
+1 NEW CAT,CNT
+2 SET CNT=0
+3 SET CAT=""
FOR
SET CAT=$ORDER(^BDPTCAT("B",CAT))
IF CAT=""
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
+5 SET LIST(CNT)=CAT
End DoDot:1
+6 QUIT
