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

BQIREM.m

Go to the documentation of this file. 
  1. BQIREM ;PRXM/HC/DLS - BQI PATIENT NATIONAL REMINDERS ; 20 Dec 2005  3:52 PM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,DFN) ; EP -- BQI PATIENT NATIONAL REMINDERS
  1.  ;Description
  1.  ;  Gets a list of precalculated reminders for a patient
  1.  ;
  1.  ;Input
  1.  ;  DFN   - Patient IEN
  1.  ;
  1.  ;Output
  1.  ;  DATA - Name of global in which data is stored(^TMP("BQIREM"))
  1.  ;
  1.  NEW UID,X,BQII,RDATA,IEN,REMCODE,REMNEXT,REMDUE,REMLAST,UPDT,VISIT
  1.  NEW REMDATE,RCAT,RCLIN,ORD,PRI,REMDESC,NPRI,LPRI,REG,RGIEN,RIEN,RLIST
  1.  NEW QFL,PREV,PRDT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIREM",UID))
  1.  K @DATA
  1.  ;
  1.  S RLIST=$G(RLIST,"")
  1.  S BQII=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIREM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  S IEN=0
  1.  F  S IEN=$O(^BQIPAT(DFN,40,IEN)) Q:'IEN  D
  1.  . S RDATA=^BQIPAT(DFN,40,IEN,0)
  1.  . S REMCODE=$P(RDATA,U,1)
  1.  . S RIEN=$O(^BQI(90506.1,"B",REMCODE,""))
  1.  . I RIEN="" Q
  1.  . I $P(^BQI(90506.1,RIEN,0),U,10)=1 Q
  1.  . S REMDESC=$P(^BQI(90506.1,RIEN,0),U,3)
  1.  . I REMDESC'?.U S REMDESC=REMDESC
  1.  . I REMDESC?.UP S REMDESC=$$LOWER^VALM1(REMDESC)
  1.  . I REMDESC="Breast Mri" S REMDESC="Breast MRI"
  1.  . S REMLAST=$P(RDATA,U,2)
  1.  . S REMNEXT=$P(RDATA,U,3)
  1.  . I $P(REMCODE,"_",1)="EHR",REMNEXT="N/A" Q
  1.  . S REMDUE=$P(RDATA,U,4)
  1.  . S UPDT=$P(RDATA,U,5)
  1.  . S VISIT=$P(RDATA,U,6)
  1.  . I REMNEXT="",REMDUE="" Q
  1.  . S PREV="N/A",PRDT=""
  1.  . S:REMDUE="" REMDUE=DT
  1.  . I $P(REMCODE,"_",1)="EHR" D
  1.  .. I REMNEXT="DONE" S REMDUE=""
  1.  .. I REMNEXT="RESOLVED" S REMDUE=""
  1.  . ;S RCAT=$$GET1^DIQ(90506.1,RIEN_",",2.03,"E")
  1.  . S RCAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
  1.  . ;S RCLIN=$$GET1^DIQ(90506.1,RIEN_",",2.05,"E")
  1.  . S RCLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
  1.  . S PRI="~",QFL=0
  1.  . I $P(REMCODE,"_",1)="REG" D  Q:QFL
  1.  .. S REG=$P(REMCODE,"_",2),RGIEN=$P(REMCODE,"_",3)
  1.  .. NEW SRC
  1.  .. S SRC=$O(^BQI(90506.5,"D",REG,""))
  1.  .. I SRC'="",'$$NRPC^BQICMDNM(DFN,SRC) S QFL=1 Q
  1.  .. S PRI=$P(^BQI(90507,REG,15,RGIEN,0),U,9)
  1.  . I $P(REMCODE,"_",1)="CMET" D
  1.  .. NEW PRVN,RMIEN
  1.  .. S RMIEN=""
  1.  .. F  S RMIEN=$O(^BTPWP("AE",DFN,"F",RMIEN)) Q:RMIEN=""  D
  1.  ... I $P(^BTPWP(RMIEN,0),U,1)'=$P(REMCODE,"_",2) Q
  1.  ... S PRVN=$P(^BTPWP(RMIEN,0),U,11)
  1.  ... S PREV=$$GET1^DIQ(90620,PRVN_",",.01,"E")
  1.  ... S PRDT=$$FMTE^BQIUL1($$GET1^DIQ(90620,PRVN_",",.03,"I"))
  1.  . ;
  1.  . S ORD(PRI,RIEN)=RCAT_U_RCLIN_U_REMCODE_U_REMDESC_U_$$FMTE^BQIUL1(REMLAST)_U_REMNEXT_U_$$FMTE^BQIUL1(REMDUE)_U_$$FMTE^BQIUL1(UPDT)_U_VISIT_U_PREV_U_PRDT
  1.  ;
  1.  S PRI=""
  1.  F  S PRI=$O(ORD(PRI)) Q:PRI=""  D  S:PRI'="~" NPRI=PRI
  1.  . S RIEN=""
  1.  . F  S RIEN=$O(ORD(PRI,RIEN)) Q:RIEN=""  D
  1.  .. I PRI'="~" S LPRI=PRI
  1.  .. I PRI="~" S NPRI=$G(NPRI)+1,LPRI=NPRI
  1.  .. S BQII=BQII+1,@DATA@(BQII)=ORD(PRI,RIEN)_U_LPRI_$C(30)
  1.  ;
  1. DONE ; Finished
  1.  S BQII=BQII+1
  1.  S @DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. HDR ; Header
  1.  S @DATA@(BQII)="T00030CATEGORY^T00030CLIN_GROUP^T00015REM_CODE^T00050REM_DESC^D00010REM_LAST^"
  1.  S @DATA@(BQII)=@DATA@(BQII)_"T00040REM_NEXT^D00010REM_DUE^D00030LAST_UPDATED^I00010VISIT_IEN^"
  1.  S @DATA@(BQII)=@DATA@(BQII)_"T00050PREV_EVENT^D00015PREV_DATE^I00003DISPLAY_ORDER"_$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.  I $$TMPFL^BQIUL1("C")
  1.  Q
  1.  ;
  1. IMM(IDFN,IMIEN) ;EP - Get immunization due/last information
  1.  ; Input
  1.  ;  IDFN  - Patient internal entry number
  1.  ;  IMIEN - Immunization internal entry number
  1.  ;
  1.  NEW BIIEN,BIDATA,BILAST
  1.  S BIIEN="",BIDATA=""
  1.  F  S BIIEN=$O(^BIPDUE("B",IDFN,BIIEN)) Q:BIIEN=""  D
  1.  . I $G(^BIPDUE(BIIEN,0))="" Q
  1.  . I $P(^BIPDUE(BIIEN,0),U,2)'=IMIEN Q
  1.  . S BIDATA=$P(^BIPDUE(BIIEN,0),U,4)_U_$$FMTE^XLFDT($P(^BIPDUE(BIIEN,0),U,5),"2Z")
  1.  . I $$PATCH^XPDUTL("BI*8.3*1") S BIDATA=BIDATA_U_$$LIMM(IDFN,IMIEN)
  1.  Q BIDATA
  1.  ;
  1. LIMM(IDFN,IMIEN) ; EP - Get Last Immunization
  1.  ; Input
  1.  ;  IDFN  - Patient internal entry number
  1.  ;  IMIEN - Immunization internal entry number
  1.  NEW IRVDT,IRIEN,RVIS,RVALUE,FOK
  1.  S RVALUE="",FOK=0,IRVDT=""
  1.  F  S IRVDT=$O(^AUPNVIMM("AA",IDFN,IMIEN,IRVDT)) Q:IRVDT=""  D  Q:FOK
  1.  . S IRIEN=""
  1.  . F  S IRIEN=$O(^AUPNVIMM("AA",IDFN,IMIEN,IRVDT,IRIEN)) Q:IRIEN=""  D  Q:FOK
  1.  .. S RVIS=$P($G(^AUPNVIMM(IRIEN,0)),U,3) I RVIS="" Q
  1.  .. I $$GET1^DIQ(9000010,RVIS_",",.11,"I")=1 Q
  1.  .. S RVALUE=$$GET1^DIQ(9000010,RVIS_",",.01,"I")\1_U_RVIS_U_IRIEN,FOK=1
  1.  Q RVALUE