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

BPXRMSEO.m

Go to the documentation of this file. 
  1. BPXRMSEO ;IHS/MSC/MGH - Reminder Reports lookup for IHS;31-May-2013 10:57;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
  1.  ;
  1.  ; Called by label from PXRMXSE
  1.  ;
  1. TMP(DFN,NAM,FACILITY,INP) ;Update ^TMP("PXRMX"
  1.  I PXRMFCMB="Y" S FACILITY="COMBINED FACILITIES"
  1.  I PXRMLCMB="Y" S NAM="COMBINED LOCATIONS"
  1.  S ^TMP("PXRMX",$J,FACILITY,NAM,DFN)=INP
  1.  Q
  1.  ;
  1.  ;Mark location as found
  1. MARK(IC) ;
  1.  S ^XTMP(PXRMXTMP,"MARKED AS FOUND",IC)=""
  1.  Q
  1.  ;
  1.  ;IHS designated provider selected (PXRMPRV)
  1. IHS N SCDT,LIST,SCERR,SCLIST,II,PCP,NAM,PNAM,OK,BUSY,CNT
  1.  N DCLN,DBDOWN,DLAST,DDUE,DDAT,DNEXT,ITEM,LIT,PX,TODAY
  1.  S DBDOWN=0
  1.  I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
  1.  ;S SCDT("BEGIN")=9999999-PXRMBDT
  1.  ;S SCDT("END")=9999999-PXRMEDT
  1.  S SCDT("BEGIN")=PXRMSDT,SCDT("END")=PXRMSDT
  1.  ;Include patient if on any day in range
  1.  S SCDT("INCL")=0
  1.  S II=""
  1.  ;Get patient list for each PROVIDER
  1.  F  S II=$O(PXRMPRV(II)) Q:II=""  D
  1.  .S PCP=$P(PXRMPRV(II),U),NAM=$P(PXRMPRV(II),U,2)
  1.  .;Get patients for practs. roles - excluding assoc clinics
  1.  .N SCTEAM D PTPR(PCP)
  1.  .I $O(^TMP($J,"PCP",0))="" Q
  1.  .;Save in ^TMP in alpha order within team number (internal)
  1.  .S CNT=0 F  S CNT=$O(^TMP($J,"PCP",CNT)) Q:CNT'>0  D
  1.  ..S DFN=$P(^TMP($J,"PCP",CNT),U)
  1.  ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Collecting pts from Designated Provider list",.BUSY)
  1.  ..;For detailed provider report get assoc clinic
  1.  ..I PXRMREP="D" S DCLN=$P(^TMP($J,"PCP",CNT),U,7) I +$G(DCLN)>0 D
  1.  ...S FACILITY=$$HFAC^PXRMXSL1(DCLN)
  1.  ...S NAM=$P(^SC(DCLN,0),U)
  1.  ...S ^XTMP(PXRMXTMP,"HLOC",DCLN)=FACILITY_U_NAM
  1.  ..I $G(DCLN)'="" S PXRMDCLN(DCLN)=""
  1.  ..D UPD1(DFN,NAM,"FACILITY",+$G(DCLN))
  1.  .D MARK(PCP)
  1.  K ^TMP($J,"PCP")
  1.  I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
  1.  I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
  1.  Q
  1.  ;
  1. VISIT(PCP) ;
  1.  N CNT,DFN,FOUND,SUB,IEN,PIEN,PROV
  1.  S CNT=0,FOUND=0
  1.  K ^TMP($J,"BPXRMPIEN")
  1.  F  S CNT=$O(^TMP($J,"PCP",CNT)) Q:'CNT  D
  1.  .S SUB="" F  S SUB=$O(^AUPNVSIT("AA",CNT,SUB)) Q:SUB=""!(SUB>SCDT("END"))!(FOUND=1)  D
  1.  ..;Loop through the visit file using the start and end dates
  1.  ..;Find visits for this patient in the date range
  1.  ..;If there is one there, use this visit number to see if this provider
  1.  ..;saw the patient,  If so include it in the list to evaluate
  1.  ..S IEN="" F  S IEN=$O(^AUPNVSIT("AA",CNT,SUB,IEN)) Q:IEN=""  D
  1.  ...S PIEN="" F  S PIEN=$O(^AUPNVPRV("AD",IEN,PIEN)) Q:PIEN=""  D
  1.  ....S PROV=$P($G(^AUPNVPRV(PIEN,0)),U,1)
  1.  ....I PROV=PCP S ^TMP($J,"BPXRMPIEN",CNT)="" S FOUND=1
  1.  Q
  1.  ;
  1.  ;
  1. UPD1(DFN,NAM,FACILITY,INP) ;
  1.  ;Remove test patients.
  1.  I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
  1.  ;Remove patients that are deceased.
  1.  I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
  1.  S ^TMP($J,"PXRM PATIENT LIST",DFN)=""
  1.  S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
  1.  D TMP(DFN,NAM,FACILITY,INP)
  1.  Q
  1.  ;
  1.  ;Detailed report
  1. SDET I $G(^XTMP(PXRMXTMP,PX,FACILITY,@SUB))="" D
  1.  .S ^XTMP(PXRMXTMP,PX,FACILITY,@SUB)=NAM
  1.  ;Applicable
  1.  N APPL,STATUS S APPL=0,STATUS=""
  1.  ;Check if due and/or applicable (active reminder for live patient)
  1.  I $P($G(^PXD(811.9,ITEM,0)),U,6)'=1 D
  1.  .D MAIN^PXRM(DFN,ITEM,0)
  1.  .;Quit if nothing returned
  1.  .S STATUS=$P($G(^TMP("PXRHM",$J,ITEM,LIT)),U) Q:STATUS=""
  1.  .;Exclude dead patients from applicable
  1.  .I $G(^XTMP("PXRMDFN"_DFN,"DOD"))'="" Q
  1.  .;Add any that aren't N/A, Ignore on N/A or NEVER to applicable total
  1.  .I (STATUS'=" ")&(STATUS'["NEVER")&(STATUS'["N/A")&(STATUS'="ERROR") S APPL=1
  1.  ;
  1.  ;If DUE NOW save details
  1.  I STATUS["DUE NOW" D
  1.  .S DDUE=$P($G(^TMP("PXRHM",$J,ITEM,LIT)),U,2)
  1.  .S DLAST=$P($G(^TMP("PXRHM",$J,ITEM,LIT)),U,3)
  1.  .;Next appointment for location or clinic
  1.  .I PXRMSEL="L" D
  1.  ..I $E(PXRMLCSC,2)'="A" D DNEXT($G(^TMP("PXRMX",$J,FACILITY,NAM,DFN)))
  1.  ..I $E(PXRMLCSC,2)="A" D DNEXT("")
  1.  ..S PNAM=$G(^XTMP("PXRMDFN"_DFN,"PATIENT"))
  1.  ..; Allow for cache being rebuilt for another user
  1.  ..I PNAM="" S PNAM=" "
  1.  .;Next appointment date at any location
  1.  .I PXRMSEL'="L" D
  1.  ..;For detailed provider report get next appoint. for assoc. clinic
  1.  ..I PXRMREP="D",PXRMSEL="P" S DNEXT="" D:DCLN'="" DNEXT(DCLN) Q
  1.  ..;Otherwise get next appointment for centre
  1.  ..D DNEXT("")
  1.  .;Sort by next appointment date
  1.  .I PXRMSRT="Y" S DDAT=$P(DNEXT,".") S:DDAT="" DDAT="NONE"
  1.  .;Patient ward/bed used only for inpatient reports
  1.  .N BED,TXT S BED=""
  1.  .S TXT=DFN_U_DDUE_U_DLAST_U_DNEXT
  1.  .I $G(PXRMINP) D
  1.  ..S BED=$G(^DPT(DFN,.101)) S:BED="" BED="NONE"
  1.  ..S TXT=TXT_U_BED
  1.  ..;Sort by bed
  1.  ..I PXRMSRT="B" S DDAT=BED
  1.  .;Duplicate check for combined report
  1.  .I PXRMFCMB="Y",'$$NEW(SUB,DDAT,PNAM) Q
  1.  .;Save entry in ^XTMP
  1.  .S ^XTMP(PXRMXTMP,PX,FACILITY,@SUB,DDAT,PNAM)=TXT
  1.  .;Total of reminders overdue
  1.  .N CNT
  1.  .S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,2)
  1.  .S $P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,2)=CNT+1
  1.  ;Total of patients checked/applicable
  1.  N CNT,NEW
  1.  S NEW=1 I PXRMFCMB="Y" S NEW=$$NEWP(SUB,DFN)
  1.  I NEW D
  1.  .S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,3)
  1.  .S $P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,3)=CNT+1
  1.  .S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,4)
  1.  .S $P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,4)=CNT+APPL
  1.  K ^TMP("PXRM",$J),^TMP("PXRHM",$J)
  1.  Q
  1.  ;
  1.  ;Find next appointment date
  1. DNEXT(IEN) ;
  1.  N FOUND
  1.  S DNEXT=TODAY,FOUND=0
  1.  F  S DNEXT=$O(^DPT(DFN,"S",DNEXT)) Q:DNEXT=""  D  Q:FOUND  ; DBIA 1301
  1.  .;Ignore cancelled appointments
  1.  .I $P($G(^DPT(DFN,"S",DNEXT,0)),U,2)["C" Q
  1.  .I (IEN>0),(+$P($G(^DPT(DFN,"S",DNEXT,0)),U)'=IEN) Q
  1.  .S FOUND=1
  1.  Q
  1. PTPR(BSDPRV) ;Find the lisZTt of this provider's primary care pts
  1.  N DFN,NAME,COMM
  1.  S DFN=0 F  S DFN=$O(^AUPNPAT("AK",+BSDPRV,DFN)) Q:'DFN  D
  1.  . S NAME=$$GET1^DIQ(2,DFN,.01)
  1.  . S ^TMP($J,"PCP",DFN)=DFN_"^"_NAME
  1.  Q
  1.  ;Combined report duplicate check (Summary report)
  1. NEW(SUB,SUB1,SUB2) ;
  1.  ;Existing entry
  1.  I $D(^TMP("PXRMCMB",$J,@SUB,SUB1,SUB2)) Q 0
  1.  ;New entry
  1.  S ^TMP("PXRMCMB",$J,@SUB,SUB1,SUB2)=""
  1.  Q 1
  1.  ;
  1.  ;Combined report duplicate check (Detail report)
  1. NEWP(SUB,DFN) ;
  1.  ;Existing entry
  1.  I $D(^TMP("PXRMCMB1",$J,@SUB,DFN)) Q 0
  1.  ;New entry
  1.  S ^TMP("PXRMCMB1",$J,@SUB,DFN)=""
  1.  Q 1
  1.  ;
  1.  ;Combined report duplicate check (Patient totals)
  1. NEWT(FACILITY,DFN) ;
  1.  ;Existing entry
  1.  I $D(^TMP("PXRMCMB2",$J,FACILITY,DFN)) Q 0
  1.  ;New entry
  1.  S ^TMP("PXRMCMB2",$J,FACILITY,DFN)=""
  1.  Q 1