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

BQIPTPR.m

Go to the documentation of this file. 
  1. BQIPTPR ;PRXM/HC/BWF-Patient Provider Utilities ; 15 Nov 2005  3:17 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  ; This is a utility program containing special function calls
  1.  ; needed for provider data.
  1.  Q
  1.  ;
  1. PTPROV(DATA,DFN,ALL) ;EP -- BQI PATIENT PROVIDERS
  1.  ; BQI PATIENT PROVIDERS
  1.  ; Input
  1.  ;  DFN  - Patient IEN
  1.  ;  DATA - Passed by reference
  1.  ;  ALL  - 1 if all provider categories are wanted
  1.  ; Output
  1.  ;  DATA - Set in this routine
  1.  ;  
  1.  ; Variables
  1.  ;  BDPIEN     - Ien from ^BDPRECN
  1.  ;  LCPROV     - Last Current Provider
  1.  ;  
  1.  N BDPIEN,UID,BQII,X,PROVLST,LCPROV,LCPROVNM,PROVCAT,PROV,BDPINST,BDPCAT
  1.  N LSTUP,LSTUPU,BQPRV
  1.  NEW LCPRVI
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTPR",UID))
  1.  K @DATA
  1.  S ALL=$G(ALL,0)
  1.  ;
  1.  S BQII=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTPR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  ;
  1.  ; Drive through all entries in the BDPRECN global for each patient.
  1.  ; BDPRECN is part of the DSPM package
  1.  ;
  1.  ; Check to see if DSPM is being used. If DSPM is not being used, get roles from
  1.  ; file/fields listed in the DSPM provider categories.
  1.  S BDPINST=$$VERSION^XPDUTL("BDP")
  1.  I BDPINST="" D GETPROVS(DFN,.BQII) Q
  1.  ;
  1.  ; Loop through DSPM provider categories (if DSPM is in use).
  1.  K BQPRV
  1.  S BDPCAT=0
  1.  F  S BDPCAT=$O(^BDPRECN("AA",DFN,BDPCAT)) Q:'BDPCAT  D
  1.  .S BDPIEN=0
  1.  .F  S BDPIEN=$O(^BDPRECN("AA",DFN,BDPCAT,BDPIEN)) Q:'BDPIEN  D
  1.  ..S LCPROV=$$GET1^DIQ(90360.1,BDPIEN,.03,"I")      ;Last Current Provider
  1.  ..I LCPROV="" Q
  1.  ..S LCPROVNM=$$GET1^DIQ(90360.1,BDPIEN,.03,"E")
  1.  ..S LCPRVI=$$GET1^DIQ(90360.1,BDPIEN,.03,"I")
  1.  ..S PROVCAT=$$GET1^DIQ(90360.3,BDPCAT,.01,"E")     ;Prov Category Name
  1.  ..S SRCAT=$S(PROVCAT="DESIGNATED PRIMARY PROVIDER":"aDESIGNATED PRIMARY PROVIDER",1:PROVCAT)
  1.  ..I ALL S BQPRV(BDPCAT)=BDPIEN
  1.  ..S PROVLST(DFN,SRCAT,LCPROV)=PROVCAT_U_LCPRVI_$C(28)_LCPROVNM_U_U
  1.  ..D PROVST(SRCAT,LCPROV)
  1.  ..S LSTUP=$$GET1^DIQ(90360.1,BDPIEN,.05,"I") I LSTUP S LSTUP=$$FMTE^BQIUL1(LSTUP)
  1.  ..S LSTUPU=$$GET1^DIQ(90360.1,BDPIEN,.04,"E")
  1.  ..S $P(PROVLST(DFN,SRCAT,LCPROV),U,6,7)=LSTUP_U_LSTUPU
  1.  I ALL D
  1.  . NEW N,CAT
  1.  . S N=0
  1.  . F  S N=$O(^BDPTCAT(N)) Q:'N  I '$D(BQPRV(N)) S CAT=$P(^BDPTCAT(N,0),U,1),PROVLST(DFN,$S(CAT="DESIGNATED PRIMARY PROVIDER":"a"_CAT,1:CAT),"~")=CAT_U_U_U_U_U_U
  1.  D LOOP(.BQII)
  1.  Q
  1.  ;
  1. PROVST(SRCAT,LCPROV) ;EP
  1.  ;Loop through visits, and find the most recent visit that is associated with the current provider.
  1.  N LSTVST,FOUND,VSTIEN,VPRVIEN,VSPROV,EXTVST,NXTVST,CLINIC,PROV,STATUS
  1.  S LSTVST=0,FOUND=0
  1.  F  S LSTVST=$O(^AUPNVSIT("AA",DFN,LSTVST)) Q:'LSTVST  D  Q:FOUND
  1.  .S VSTIEN=0
  1.  .F  S VSTIEN=$O(^AUPNVSIT("AA",DFN,LSTVST,VSTIEN)) Q:VSTIEN=""!(FOUND)  D
  1.  ..I $$GET1^DIQ(9000010,VSTIEN,.11,"I")=1 Q
  1.  ..S VPRVIEN=0
  1.  ..F  S VPRVIEN=$O(^AUPNVPRV("AD",VSTIEN,VPRVIEN)) Q:'VPRVIEN!(FOUND)  D
  1.  ...S VSPROV=$$GET1^DIQ(9000010.06,VPRVIEN,.01,"I")
  1.  ...I VSPROV=LCPROV D  Q
  1.  ....S EXTVST=9999999-$P(LSTVST,".")
  1.  ....S EXTVST=$$FMTE^BQIUL1(EXTVST)
  1.  ....S $P(PROVLST(DFN,SRCAT,LCPROV),U,3)=$$FMTE^BQIUL1(EXTVST),FOUND=1
  1.  ....S $P(PROVLST(DFN,SRCAT,LCPROV),U,5)=VSTIEN
  1.  ;
  1.  ; Loop through patient appts and find out if prov is primary for appt clinic.
  1.  ; S NXTVST=DT,FOUND=0
  1.  ; Start date for appointment search should be 'NOW' to be consistent with PEND^BSDU
  1.  S NXTVST=$$NOW^XLFDT,FOUND=0
  1.  F  S NXTVST=$O(^DPT(DFN,"S",NXTVST)) Q:NXTVST=""!(FOUND)  D
  1.  .S CLINIC=$$GET1^DIQ(2.98,NXTVST_","_DFN_",",.01,"I")
  1.  .S STATUS=$$GET1^DIQ(2.98,NXTVST_","_DFN_",",.02,"I")
  1.  .I CLINIC="" Q
  1.  .I STATUS="C"!(STATUS="PC") Q
  1.  .N TPRI
  1.  .S TPRI=0
  1.  .F  S TPRI=$O(^SC(CLINIC,"PR",TPRI)) Q:'TPRI!(FOUND)  D
  1.  ..I +$G(^SC(CLINIC,"PR",TPRI,0))=LCPROV S $P(PROVLST(DFN,SRCAT,LCPROV),U,4)=$$FMTE^BQIUL1(NXTVST),FOUND=1
  1.  Q
  1.  ;
  1. LOOP(BQII) ;EP
  1.  NEW PCAT,LOOP
  1.  S PCAT=$O(PROVLST(DFN,"Z"))
  1.  I PCAT'="" D
  1.  . S LOOP=""
  1.  . F  S LOOP=$O(PROVLST(DFN,PCAT,LOOP)) Q:LOOP=""  D
  1.  .. S BQII=BQII+1,@DATA@(BQII)=PROVLST(DFN,PCAT,LOOP)_$C(30)
  1.  .. K PROVLST(DFN,PCAT)
  1.  S PCAT=""
  1.  F  S PCAT=$O(PROVLST(DFN,PCAT)) Q:PCAT=""  D
  1.  . S LOOP=""
  1.  . F  S LOOP=$O(PROVLST(DFN,PCAT,LOOP)) Q:LOOP=""  D
  1.  .. S BQII=BQII+1,@DATA@(BQII)=PROVLST(DFN,PCAT,LOOP)_$C(30)
  1.  S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. GETPROVS(DFN,BQII) ;EP
  1.  N DPCP,DPCPI,MHPROV,MHPROVI,SSPROV,SSPROVI,CDPROV,CDPROVI
  1.  NEW WHPROV,WHPROVI,TEXT,TIEN
  1.  S DPCP=$$GET1^DIQ(9000001,DFN,.14,"E") I DPCP'="" D
  1.  . S DPCPI=$$GET1^DIQ(9000001,DFN,.14,"I")
  1.  . S TEXT="DESIGNATED PRIMARY PROVIDER",SRCAT="a"_TEXT
  1.  . S TIEN=$$FIND1^DIC(90360.3,,"X",TEXT)
  1.  . S PROVLST(DFN,SRCAT,TIEN)=TEXT_U_DPCPI_$C(28)_DPCP_U_U
  1.  . D PROVST(SRCAT,TIEN)
  1.  ;
  1.  S MHPROV=$$GET1^DIQ(9002011.55,DFN,.02,"E") I MHPROV'="" D
  1.  . S MHPROVI=$$GET1^DIQ(9002011.55,DFN,.02,"I")
  1.  . S TEXT="MENTAL HEALTH",SRCAT=TEXT
  1.  . S TIEN=$$FIND1^DIC(90360.3,,"X",TEXT)
  1.  . S PROVLST(DFN,SRCAT,TIEN)=TEXT_U_MHPROVI_$C(28)_MHPROV_U_U
  1.  . D PROVST(SRCAT,TIEN)
  1.  ;
  1.  S SSPROV=$$GET1^DIQ(9002011.55,DFN,.03,"E") I SSPROV'="" D
  1.  . S SSPROVI=$$GET1^DIQ(9002011.55,DFN,.03,"I")
  1.  . S TEXT="SOCIAL SERVICES",SRCAT=TEXT
  1.  . S TIEN=$$FIND1^DIC(90360.3,,"X",TEXT)
  1.  . S PROVLST(DFN,SSPROVI,TIEN)=TEXT_U_SSPROVI_$C(28)_SSPROV_U_U
  1.  . D PROVST(SRCAT,TIEN)
  1.  ;
  1.  S CDPROV=$$GET1^DIQ(9002011.55,DFN,.04,"E") I CDPROV'="" D
  1.  . S CDPROVI=$$GET1^DIQ(9002011.55,DFN,.04,"I")
  1.  . S TEXT="CHEMICAL DEPENDENCY",SRCAT=TEXT
  1.  . S TIEN=$$FIND1^DIC(90360.3,,"X",TEXT)
  1.  . S PROVLST(DFN,CDPROVI,TIEN)=TEXT_U_CDPROVI_$C(28)_CDPROV_U_U
  1.  . D PROVST(SRCAT,TIEN)
  1.  ;
  1.  S WHPROV=$$GET1^DIQ(9002086,DFN,.1,"E") I WHPROV'="" D
  1.  . S WHPROVI=$$GET1^DIQ(9002086,DFN,.1,"I")
  1.  . S TEXT="WOMENS HEALTH",SRCAT=TEXT
  1.  . S TIEN=$$FIND1^DIC(90360.3,,"X",TEXT)
  1.  . S PROVLST(DFN,SRCAT,TIEN)=TEXT_U_WHPROVI_$C(28)_WHPROV_U_U
  1.  . D PROVST(SRCAT,TIEN)
  1.  ;
  1.  D LOOP(.BQII)
  1.  Q
  1.  ;
  1. HDR ;
  1.  ;S @DATA@(BQII)="T00045BQIPROLE^T00055BQIPROV^D00020BQILVDT^D00020BQINVDT^I00010VIEN"_$C(30)
  1.  S @DATA@(BQII)="T00045BQIPROLE^T00055BQIPROV^D00020BQILVDT^D00020BQINVDT^I00010VIEN^D00020BQIUPDT^T00035BQIUPDUS"_$C(30)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q