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

BDPAPI.m

Go to the documentation of this file. 
  1. BDPAPI ; IHS/CMI/TMJ - ADD A NEW DESIGNATED PROVIDER ;
  1.  ;;2.0;IHS PCC SUITE;**2,10,21**;MAY 14, 2009;Build 34
  1.  ;
  1. AEDWH(BDPPAT,BDPIEN,BDPRET) ;PEP - called to add, edit or delete a WOMEN's HEALTH CASE MANAGER
  1.  ;
  1.  ;BDPPAT - DFN of patient
  1.  ;BDPIEN - ien of provider in file 200 to add as WHCM if one doesn't exist
  1.  ;         or edit the existing provider if there is one
  1.  ;         OR "@" to delete the existing WHCM and not replace it
  1.  ;BDPRET - return value  1 if successful, 0^ERROR MESSAGE if not successful
  1.  ;
  1.  ;e.g to make provider with IEN 1234 as the WHCM for patient 3456
  1.  ;     S X=$$AEDWH^BDPAPI(3456,1234)
  1.  ;e.g to remove the current WHCM and not replace it (for example, if patient moves or dies)
  1.  ;     S X=$$AEDWH^BDPAPI(3456,"@")
  1.  ;
  1.  I '$G(BDPPAT) S BDPRET="0^valid patient DFN passed" Q
  1.  I '$D(^AUPNPAT(BDPPAT)) S BDPRET="0^patient not in patient file" Q
  1.  NEW BDPCIEN,BDPRIEN,X
  1.  S BDPCIEN=$O(^BDPTCAT("B","WOMEN'S HEALTH CASE MANAGER",0))
  1.  I 'BDPCIEN S BDPRET="0^WOMEN'S HEALTH CASE MANAGER category not found" Q
  1.  I '$G(BDPIEN),BDPIEN'="@" S BDPRET="0^PROVIDER IEN OR @ NOT PASSED" Q
  1.  I BDPIEN,'$D(^VA(200,BDPIEN,0)) S BDPRET="0^INVALID PROVIDER IEN PASSED" Q
  1.  ;
  1.  I BDPIEN="@" S BDPRET=$$DEL1(BDPPAT,BDPCIEN) Q
  1.  S BDPRIEN=$O(^BDPRECN("AA",BDPPAT,BDPCIEN,0))  ;get ien of this patient/category
  1.  I 'BDPRIEN S BDPRIEN=$$ADD1(BDPPAT,BDPCIEN) I 'BDPRIEN S BDPRET=BDPRIEN Q
  1.  I $P(^BDPRECN(BDPRIEN,0),U,3)=BDPIEN S BDPRET=1 Q  ;that already is the provider so don't bother
  1.  ;
  1.  S BDPRET=$$EDIT(BDPRIEN,BDPCIEN,BDPIEN)
  1.  Q
  1.  ;
  1. AEDAP(BDPPAT,BDPIEN,BDPTYPE,BDPRET) ;PEP - called to add, edit or delete any designated provider by category
  1.  ;this will add a new provider with the category BDPTYPE as the provider category
  1.  ;
  1.  ;BDPPAT - DFN of patient
  1.  ;BDPIEN - ien of provider in file 200 to add a new provider or edit the existing provider to this one
  1.  ;         OR "@" to delete the existing provider and not replace it
  1.  ;BDPTYPE - name of category to add this provider for e.g. "DPCP" or "RENAL DISEASE"
  1.  ;BDPRET - return value  1 if successful, 0^ERROR MESSAGE if not successful
  1.  ;e.g to make provider with IEN 1234 as the WHCM for patient 3456
  1.  ;     S X=$$AEDAP^BDPAPI(3456,1234,"RENAL DISEASE",.RETURN)
  1.  ;e.g to remove the current WHCM and not replace it (for example, if patient moves or dies)
  1.  ;     S X=$$AEDAP^BDPAPI(3456,"@","WOMEN'S HEALTH CASE MANAGER",.RETURN)
  1.  ;
  1.  I '$G(BDPPAT) S BDPRET="0^valid patient DFN passed" Q
  1.  I '$D(^AUPNPAT(BDPPAT)) S BDPRET="0^patient not in patient file" Q
  1.  NEW BDPCIEN,BDPRIEN,X
  1.  S BDPCIEN=$O(^BDPTCAT("B",BDPTYPE,0))
  1.  I 'BDPCIEN S BDPRET="0^Provider category not found" Q
  1.  I '$G(BDPIEN),BDPIEN'="@" S BDPRET="0^PROVIDER IEN OR @ NOT PASSED" Q
  1.  I BDPIEN,'$D(^VA(200,BDPIEN,0)) S BDPRET="0^INVALID PROVIDER IEN PASSED" Q
  1.  ;
  1.  I BDPIEN="@" S BDPRET=$$DEL1(BDPPAT,BDPCIEN) Q
  1.  S BDPRIEN=$O(^BDPRECN("AA",BDPPAT,BDPCIEN,0))  ;get ien of this patient/category
  1.  I 'BDPRIEN S BDPRIEN=$$ADD1(BDPPAT,BDPCIEN) I 'BDPRIEN S BDPRET=BDPRIEN Q
  1.  I $P(^BDPRECN(BDPRIEN,0),U,3)=BDPIEN S BDPRET=1 Q  ;that already is the provider so don't bother
  1.  ;
  1.  S BDPRET=$$EDIT(BDPRIEN,BDPCIEN,BDPIEN)
  1.  Q
  1.  ;
  1. ADD1(BDPDFN,BDPTYPE) ;EP - add to top level of file for this category
  1.  NEW X S X=$O(^BDPRECN("AA",BDPDFN,BDPTYPE,0)) I X Q X
  1.  K DIC
  1.  S DIC="^BDPRECN(",DIC(0)="L",DLAYGO=90360.1,DIC("DR")=".02////"_BDPDFN,X=BDPTYPE
  1.  D FILE^BDPFMC
  1.  I Y<0 Q "0^UNABLE TO ADD - FILEMAN FAILED"
  1.  Q +Y
  1.  ;
  1. EDIT(BDPRIEN,BDPTYPE,BDPPROV) ;EP - edit/add to multiple
  1.  I '$G(BDPRIEN) Q "0^RECORD IEN INVALID"
  1.  I '$G(BDPTYPE) Q "0^PROVIDER TYPE INVALID"
  1.  I '$D(BDPPROV) Q "0^PROVIDER IEN INVALID"
  1.  NEW X,BDPLIEN,C,BDPLNUM,BDPNIEN
  1.  S:'$D(^BDPRECN(BDPRIEN,1,0)) $P(^(0),U,2)="90360.11P"
  1.  S (X,BDPLIEN,BDPLNUM)=0
  1.  F  S X=$O(^BDPRECN(BDPRIEN,1,X)) Q:X'=+X  S BDPLIEN=X,BDPLNUM=BDPLNUM+1  ;get last ien in multiple
  1.  S BDPNIEN=BDPLIEN+1
  1.  S BDPLNUM=BDPLNUM+1
  1.  S $P(^BDPRECN(BDPRIEN,1,0),U,3)=BDPNIEN
  1.  S $P(^BDPRECN(BDPRIEN,1,0),U,4)=BDPLNUM
  1.  ;INACTIVE PREVIOUS ONE
  1.  S BDPLINKI=1  ;tell fileman you are coming from BDP
  1.  K DIE,DA,DR
  1.  I BDPNIEN'=1,$P(^BDPRECN(BDPRIEN,1,BDPLIEN,0),U,5)="" S DIE="^BDPRECN("_BDPRIEN_",1,",DA(1)=BDPRIEN,DA=BDPLIEN,DR=".02////"_DUZ_";.03////"_DT_";.05////"_DT D ^DIE K DIE,DR,DA,DINUM
  1.  ;S DR=".01///"_"`"_BDPPROV
  1.  S ^BDPRECN(BDPRIEN,1,BDPNIEN,0)=BDPPROV_U_DUZ_U_DT_U_DT
  1.  ;L +^BDPRECN(BDPRIEN):10 I '$T Q "0^UNABLE TO LOCK GLOBAL"
  1.  ;S DIE="^BDPRECN("_BDPRIEN_",1,",DA(1)=BDPRIEN,DA=BDPLIEN D ^DIE K DIE,DR,DA,DINUM
  1.  ;L -^BDPRECN(BDPRIEN)
  1.  ;REINDEX MULTIPLE ENTRY
  1.  NEW DIK
  1.  S DA(1)=BDPRIEN,DA=BDPNIEN,DIK="^BDPRECN("_BDPRIEN_",1," D IX^DIK K DIC,DA
  1.  ;I $D(Y) Q "0^ADDING PROVIDER TO LOG FAILED"
  1.  Q 1
  1.  ;
  1. DEL1(BDPPAT,BDPTYPE) ;
  1.  NEW BDPX
  1.  S BDPX=$O(^BDPRECN("AA",BDPPAT,BDPTYPE,0))
  1.  I 'BDPX Q 1  ;doesn't have one so can't delete it
  1.  NEW DA,DIE,DR,X,Y,DINUM
  1.  S DA=BDPX,DIE="^BDPRECN(",DR=".03///@;.04////"_DUZ_";.05////"_DT D ^DIE   ;IHS/CMI/LAB = added .04/.05 updating patch 22
  1.  ;NOW WE HAVE TO UPDATE THE INACTIVE DATE IN THE MULTIPLE FOR THIS ONE BEING DELETED
  1.  ;FIND THE MULTIPLE AND SET .05 EQUAL TO DT, .02 AND .03
  1.  S X=0 F  S X=$O(^BDPRECN(BDPX,1,X)) Q:X'=+X  S Y=X
  1.  I Y,$P(^BDPRECN(BDPX,1,Y,0),U,5)="" S DIE="^BDPRECN("_BDPX_",1,",DA(1)=BDPX,DA=Y,DR=".02////"_DUZ_";.03////"_DT_";.05////"_DT D ^DIE K DIE,DR,DA,DINUM
  1.  Q 1
  1.  ;
  1. WHPCP(BDPPAT,BDPRET) ;PEP - return WH case managers and DPCP
  1.  ; input:  BDPPAT - DFN of patient
  1.  ;         BDPRET - return array
  1.  ; return array BDPRET:
  1.  ;        BDPRET(category name)=name of provider^ien of provider^provider class of provider^date updated
  1.  ;        BDPRET("WOMEN'S HEALTH CASE MANAGER")=name of provider^ien of provider^provider class of provider^date updated
  1.  ;        BDPRET("DESIGNATED PRIMARY PROVIDER")=name of provider^ien of provider^provider class of provider^date updated
  1.  ;        BDPRET("WOMEN'S HEALTH ALTERNATE")=name of provider^ien of provider^provider class of provider^date updated
  1.  ;        
  1.  ;        If the patient does not have a provider in any of the above categories the array will not
  1.  ;        contain that category so if there is no dpcp then '$D(BDPRET("DESIGNATED PRIMARY CARE PROVIDER")
  1.  ;        will be true
  1.  ;
  1.  K BDPRET
  1.  I $G(BDPPAT)="" Q
  1.  NEW BDPX,BDPY,BDPZ,BDPCIEN
  1.  S BDPCIEN=$O(^BDPTCAT("B","DESIGNATED PRIMARY PROVIDER",0))
  1.  S BDPX=$O(^BDPRECN("AA",BDPPAT,BDPCIEN,0))
  1.  I BDPX,$P($G(^BDPRECN(BDPX,0)),U,3)]"" S BDPY="DESIGNATED PRIMARY PROVIDER" D SETV
  1.  S BDPCIEN=0 F  S BDPCIEN=$O(^BDPTCAT(BDPCIEN)) Q:BDPCIEN'=+BDPCIEN  I $P(^BDPTCAT(BDPCIEN,0),U,6) D
  1.  .S BDPX=$O(^BDPRECN("AA",BDPPAT,BDPCIEN,0))
  1.  .Q:'BDPX
  1.  .Q:$P(^BDPRECN(BDPX,0),U,3)=""
  1.  .S BDPY=$P(^BDPTCAT(BDPCIEN,0),U,1) D SETV
  1.  .Q
  1.  Q
  1. SETV ;
  1.  NEW BDPI
  1.  S BDPI=$$VALI^XBDIQ1(90360.1,BDPX,.03)
  1.  S BDPRET(BDPY)=$$VAL^XBDIQ1(90360.1,BDPX,.03)_"^"_BDPI_"^"_$$VAL^XBDIQ1(200,BDPI,53.5)_"^"_$$VALI^XBDIQ1(90360.1,BDPX,.05)
  1.  Q
  1. ALLDP(BDPPAT,BDPTYPE,BDPRET) ;PEP - return array of designated providers in all categories or 1 category
  1.  ; input:  BDPPAT - DFN of patient
  1.  ;         BDPTYPE - null if want all designated providers, or NAME of category, (e.g. RENAL DISEASE)
  1.  ;                   if just want 1 provider category
  1.  ;         BDPRET - return array
  1.  ; return array BDPRET:
  1.  ;        BDPRET(category name)=name of provider^ien of provider^provider class of provider^date updated
  1.  ;        example:
  1.  ;        BDPRET("WOMEN'S HEALTH CASE MANAGER")=name of provider^ien of provider^provider class of provider^date updated
  1.  ;        BDPRET("DESIGNATED PRIMARY PROVIDER")=name of provider^ien of provider^provider class of provider^date updated
  1.  ;    
  1.  K BDPRET
  1.  I $G(BDPPAT)="" Q
  1.  S BDPTYPE=$G(BDPTYPE)
  1.  NEW BDPX,BDPY,BDPZ,BDPCIEN
  1.  S BDPCIEN=0 F  S BDPCIEN=$O(^BDPRECN("AA",BDPPAT,BDPCIEN)) Q:BDPCIEN'=+BDPCIEN  D
  1.  .I BDPTYPE]"",$P(^BDPTCAT(BDPCIEN,0),U)'=BDPTYPE Q  ;don't want this one
  1.  .S BDPX=$O(^BDPRECN("AA",BDPPAT,BDPCIEN,0))
  1.  .Q:'BDPX
  1.  .Q:$P(^BDPRECN(BDPX,0),U,3)=""
  1.  .S BDPY=$P(^BDPTCAT(BDPCIEN,0),U,1) D SETV
  1.  .Q
  1.  Q
  1. PROVPANL(BDPPIEN) ;PEP - entry point to view/update one provider's panel
  1.  I '$G(BDPPIEN) Q
  1.  D EN^BDPDPEE
  1.  Q
  1. ALLDPVG(BDPPAT,BDPTYPE,BDPRET) ;PEP - return array of designated providers in all categories or 1 category
  1.  ; input:  BDPPAT - DFN of patient
  1.  ;         BDPTYPE - null if want all designated providers, or NAME of category, (e.g. RENAL DISEASE)
  1.  ;                   if just want 1 provider category
  1.  ;         BDPRET - return array
  1.  ; return array BDPRET:
  1.  ;        BDPRET(category IEN)=name of category^name of provider^ien of provider^provider class of provider^date updated^user last update
  1.  ;        example:
  1.  ;        BDPRET(12)=name of category^name of provider^ien of provider^provider class of provider^date updated
  1.  ;    
  1.  K BDPRET
  1.  I $G(BDPPAT)="" Q
  1.  S BDPTYPE=$G(BDPTYPE)
  1.  NEW BDPX,BDPY,BDPZ,BDPCIEN
  1.  S BDPCIEN=0 F  S BDPCIEN=$O(^BDPRECN("AA",BDPPAT,BDPCIEN)) Q:BDPCIEN'=+BDPCIEN  D
  1.  .I BDPTYPE]"",$P(^BDPTCAT(BDPCIEN,0),U)'=BDPTYPE Q  ;don't want this one
  1.  .S BDPX=$O(^BDPRECN("AA",BDPPAT,BDPCIEN,0))
  1.  .Q:'BDPX
  1.  .Q:$P(^BDPRECN(BDPX,0),U,3)=""
  1.  .S BDPY=BDPCIEN D SETV1
  1.  .Q
  1.  Q
  1. SETV1 ;
  1.  NEW BDPI
  1.  S BDPI=$$VALI^XBDIQ1(90360.1,BDPX,.03)
  1.  S BDPRET(BDPY)=$P(^BDPTCAT(BDPCIEN,0),U,1)_"^"_$$VAL^XBDIQ1(90360.1,BDPX,.03)_"^"_BDPI_"^"_$$VAL^XBDIQ1(200,BDPI,53.5)_"^"_$$VALI^XBDIQ1(90360.1,BDPX,.05)_"^"_$$VALI^XBDIQ1(90360.1,BDPX,.04)
  1.  Q
  1. MA(P) ;PEP - called to get message agent for a patient
  1.  ;input - DFN
  1.  ;output - message agent IEN from file 200^message agent name^message agent email address from message agent file
  1.  ;if no message agent assigned to the patient null is returned
  1.  I '$G(P) Q ""
  1.  I '$D(^DPT(P,0)) Q ""
  1.  NEW I,N,R,E
  1.  D ALLDP^BDPAPI(P,"MESSAGE AGENT",.R)
  1.  I '$D(R("MESSAGE AGENT")) Q ""  ;patient does not have a message agent
  1.  S N=$P(R("MESSAGE AGENT"),U,1)  ;name
  1.  S I=$P(R("MESSAGE AGENT"),U,2)  ;ien in file 200
  1.  S E=$$GET1^DIQ(90360.5,I,.02)  ;dir email
  1.  Q I_"^"_N_"^"_E