Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BEHOPTPC

BEHOPTPC.m

Go to the documentation of this file.
  1. 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
  1. ;=================================================================
  1. USESD() Q $G(DUZ("AG"))'="I"
  1. ; Get the primary provider
  1. OUTPTPR(DFN) ;EP
  1. Q:$$USESD $$OUTPTPR^SDUTL3(DFN)
  1. N PCP
  1. S PCP=$$GET1^DIQ(9000001,DFN,.14,"I")
  1. Q $S(PCP:PCP_U_$P(^VA(200,PCP,0),U),1:"")
  1. ; Get team
  1. OUTPTTM(DFN) ;EP
  1. Q:$$USESD $$OUTPTTM^SDUTL3(DFN)
  1. N TM
  1. S TM=$O(^BSDPCT("AB",+$$OUTPTPR(DFN),0))
  1. Q $S(TM:TM_U_$$GET1^DIQ(9009017.5,TM,.01),1:"")
  1. ; Return Primary Care Detail information
  1. DETAIL(DATA,DFN) ;EP
  1. I $$USESD D
  1. .N I,X
  1. .S X=$$OUTPTTM^SDUTL3(DFN,DT),I=0
  1. .I X>0 D
  1. ..D ADDDET($P(X,U,2),"Primary Care Team")
  1. ..D ADDDET($P($G(^SCTM(404.51,+X,0)),U,2),"Phone")
  1. .E D ADDDET("No Primary Care Team Assigned.")
  1. .D ADDPRV("Primary Care Provider",+$$OUTPTPR^SDUTL3(DFN,DT))
  1. .D ADDPRV("Associate Provider",+$$OUTPTAP^SDUTL3(DFN,DT))
  1. .D ADDPRV("Attending Physician",+$G(^DPT(DFN,.1041)),1)
  1. E D
  1. .N I,X,BDPQ,BDPTYPE,BDPCOUNT,BDPRIEN,BDPTYPNM,BDPCPRV
  1. .S I=0
  1. .D ADDDET("**CURRENT DESIGNATED PROVIDERS - BY PROVIDER CATEGORY TYPE**")
  1. .I '$D(^BDPRECN("AA",DFN)) D ADDDET("**--NO EXISTING DESIGNATED PROVIDERS--**") Q
  1. .S BDPQ=0,BDPTYPE="",BDPCOUNT=0
  1. .F S BDPTYPE=$O(^BDPRECN("AA",DFN,BDPTYPE)) Q:BDPTYPE="" D
  1. ..S BDPCOUNT=BDPCOUNT+1,BDPRIEN=""
  1. ..S BDPTYPNM=$P(^BDPTCAT(BDPTYPE,0),U) ;Type Print
  1. ..F S BDPRIEN=$O(^BDPRECN("AA",DFN,BDPTYPE,BDPRIEN)) Q:BDPRIEN'=+BDPRIEN D
  1. ...S BDPCPRV=+$P($G(^BDPRECN(BDPRIEN,0)),U,3)
  1. ...Q:'+BDPCPRV
  1. ...;Current Provider IEN
  1. ...;S BDPCPRVP=$S(BDPCPRV:$P($G(^VA(200,BDPCPRV,0)),U),1:"<None Currently Assigned>")
  1. ...S BDPCPRVP=$P($G(^VA(200,BDPCPRV,0)),U)
  1. ...D ADDDET(BDPCOUNT_" "_$$LJ^XLFSTR($E(BDPTYPNM,1,30),30)_": "_$$LJ^XLFSTR($E(BDPCPRVP,1,35),45))
  1. Q
  1. ADDDET(TXT,LBL) ;
  1. Q:'$L($G(TXT))
  1. S:$D(LBL) TXT=$$RJ^XLFSTR(LBL,21)_": "_TXT
  1. S DATA(I)=TXT,I=I+1
  1. Q
  1. ADDPRV(TYP,PRV,FLG) ;
  1. D ADDDET(" ")
  1. I $D(^VA(200,PRV,0)) D
  1. .N X
  1. .D ADDDET($P(^VA(200,PRV,0),U),TYP)
  1. .S X=$G(^VA(200,PRV,.13))
  1. .D ADDDET($P(X,U,7),"Analog Pager")
  1. .D ADDDET($P(X,U,8),"Digital Pager")
  1. .D ADDDET($P(X,U,2),"Office Phone")
  1. E D:'$G(FLG) ADDDET("No "_TYP_" Assigned.")
  1. Q
  1. ; Find all providers on the team associated with the primary provider
  1. TEAM(BEHODUZ) ;EP
  1. N BEHOX,BEHOY,BEHOTM,BEHOCT
  1. K ^TMP("ORIHS",$J)
  1. ;BEHOX is the team of the primary provider
  1. S BEHOCT=0,BEHOX=$O(^BSDPCT("AB",BEHODUZ,0)),BEHOY=0
  1. Q:'BEHOX
  1. F S BEHOY=$O(^BSDPCT(BEHOX,1,BEHOY)) Q:BEHOY="" D
  1. .S BEHOTM=$P($G(^BSDPCT(BEHOX,1,BEHOY,0)),U)
  1. .S:BEHOTM'="" ^TMP("ORIHS",$J,BEHOTM)=""
  1. Q
  1. GETBDP(RET,DFN) ;RPC to get all designated providers for a patient
  1. N ARRAY,CNT
  1. D ALLDP^BDPAPI(DFN,"",.ARRAY)
  1. S CNT=0
  1. S TYP="" F S TYP=$O(ARRAY(TYP)) Q:TYP="" D
  1. .S TXT=$G(ARRAY(TYP))
  1. .I TXT'="" D
  1. ..S CNT=CNT+1
  1. ..S RET(CNT)=TYP_U_TXT
  1. Q
  1. SETBDP(RET,DFN,TYPE,PROV) ;RPC to add/edit/delete a provider for a category
  1. D AEDAP^BDPAPI(DFN,PROV,TYPE,.RET)
  1. Q
  1. GETCATS(LIST) ;Return the list of categories
  1. N CAT,CNT
  1. S CNT=0
  1. S CAT="" F S CAT=$O(^BDPTCAT("B",CAT)) Q:CAT="" D
  1. .S CNT=CNT+1
  1. .S LIST(CNT)=CAT
  1. Q