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

BPXRMPRC.m

Go to the documentation of this file. 
  1. BPXRMPRC ; IHS/MSC/MGH - Code to handle V PROCEDURE ;03-Mar-2016 11:29;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1001,1007**;Feb 04, 2005;Build 12
  1.  ;
  1.  ;====================================================
  1. FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
  1.  N DAS,DATE,DS,EDTT,ICDP,IND,NFOUND,NODE,NNODE,TE,TLIST,TS
  1.  N TDATE,TIND,CODESYS
  1.  I $G(^PXRMINDX(9000010.08,"DATE BUILT"))="" D  Q
  1.  . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.08)
  1.  I '$D(^PXRMINDX(9000010.08,"PPI",DFN)) Q
  1.  ;S NNODE=+$P($G(TAXARR("PDS",9000010.08,80.1)),U,2)
  1.  ;I NNODE=0 Q
  1.  S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1.  S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
  1.  S TS=$O(TAXARR(80.1,""))-1
  1.  S TE=$O(TAXARR(80.1,""),-1)
  1.  S NFOUND=0
  1.  ;F IND=1:1:NNODE D
  1.  ;S NODE=TAXARR("PDS",9000010.08,80.1,IND)
  1.  ;S ICDP=TS
  1.  S ICDP=""
  1.  S NODE=""
  1.  ;IHS/MSC/MGH Section redone for ICD-10 codes patch 1007
  1.  F  S NODE=$O(^PXRMINDX(9000010.08,"PPI",DFN,NODE)) Q:NODE=""  D
  1.  .F CODESYS="10P","ICP" D
  1.  ..S CODE=""
  1.  ..F  S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE=""  D
  1.  ... S ICDP=TAXARR("AE",CODESYS,CODE)
  1.  ... ;IHS/MSC/MGH changed 1007 to get IEN of code
  1.  ... I CODESYS="10P" S ICDP=+$$CODEN^ICDEX(CODE,80.1)
  1.  ... I '$D(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP)) Q
  1.  ... S DATE=DS
  1.  ... F  S DATE=+$O(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP,DATE),SDIR) Q:$S(DATE=0:1,DATE<BDT:1,DATE>EDTT:1,1:0)  D
  1.  .... S DAS=$O(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP,DATE,""))
  1.  .... S NFOUND=NFOUND+1
  1.  .... S TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_ICDP_U_NODE
  1.  .... I NFOUND>NGET D
  1.  ..... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
  1.  ..... K TLIST(TDATE,TIND)
  1.  ;Return up to NGET of the most recent entries.
  1.  S NFOUND=0
  1.  S DATE=""
  1.  F  S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NGET)  D
  1.  . S IND=0
  1.  . F  S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NGET)  D
  1.  .. S NFOUND=NFOUND+1
  1.  .. S FLIST(DATE,NFOUND,9000010.08)=TLIST(DATE,IND)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. GETDATA(DAS,FIEVT) ;Return data for a specified V POV entry.
  1.  ;DBIA #4250
  1.  D VPRC^BPXRMPX(DAS,.FIEVT)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V PROCEDURE entries.
  1.  N DAS,DATE,DFN,DS,ICDP,IND,NFOUND,NODE,NNODE,TEMP,TLIST
  1.  I $G(^PXRMINDX(9000010.08,"DATE BUILT"))="" D  Q
  1.  . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.08)
  1.  S TLIST="GPLIST_BPXRMPRC"
  1.  S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1.  S NNODE=+$P($G(TAXARR("PDS",9000010.08,80.1)),U,2)
  1.  I NNODE=0 Q
  1.  S ICDP=""
  1.  F  S ICDP=$O(TAXARR(80.1,ICDP)) Q:(ICDP="")  D
  1.  . I '$D(^PXRMINDX(9000010.08,"IPP",ICDP)) Q
  1.  . F IND=1:1:NNODE D
  1.  .. S NODE=TAXARR("PDS",9000010.08,80.1,IND)
  1.  .. I '$D(^PXRMINDX(9000010.08,"IPP",ICDP,NODE)) Q
  1.  .. S DFN=0
  1.  .. F  S DFN=$O(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN)) Q:DFN=""  D
  1.  ... S DATE=DS
  1.  ... F  S DATE=+$O(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)  D
  1.  .... S DAS=$O(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN,DATE,""))
  1.  .... S ^TMP($J,TLIST,DFN,DATE,DAS)=ICDP_U_"ICD0"_U_NODE
  1.  ;Return up to NOCC of the most recent entries for each patient.
  1.  S DFN=0
  1.  F  S DFN=$O(^TMP($J,TLIST,DFN)) Q:DFN=""  D
  1.  . S NFOUND=0
  1.  . S DATE=""
  1.  . F  S DATE=$O(^TMP($J,TLIST,DFN,DATE),-1) Q:(DATE="")!(NFOUND=NOCC)  D
  1.  .. S DAS=""
  1.  .. F  S DAS=$O(^TMP($J,TLIST,DFN,DATE,DAS)) Q:DAS=""  D
  1.  ... S NFOUND=NFOUND+1
  1.  ... S TEMP=^TMP($J,TLIST,DFN,DATE,DAS)
  1.  ... S ICDP=$P(TEMP,U,1)
  1.  ... S ^TMP($J,PLIST,1,DFN,NFOUND,9000010.08)=DAS_U_DATE_U_TEMP
  1.  K ^TMP($J,TLIST)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
  1.  N CODE,D0,PROC,EM,ICD0P,ICD0ZN,ICD9ZN,IND,JND,NAME,NIN,NOUT,PN,RANK
  1.  N TEMP,TEXTIN,TEXTOUT,VDATE
  1.  S NAME="Procedure = "
  1.  S IND=0
  1.  F  S IND=$O(OCCLIST(IND)) Q:IND=""  D
  1.  . S VDATE=IFIEVAL(IND,"DATE")
  1.  . S ICD0P=IFIEVAL(IND,"CODEP")
  1.  . S D0=$G(^AUPNVPRC(IFIEVAL(IND,"DAS"),0))
  1.  . S ICD9ZN=$$ICDOP^ICDCODE(ICD0P,VDATE)
  1.  . S CODE=$P(ICD0ZN,U,2)
  1.  . S PROC=$P(ICD0ZN,U,5)
  1.  . S TEMP=NAME_PROC_" ("_$$EDATE^PXRMDATE(VDATE)_")"
  1.  . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,4,.TEXTIN,.NOUT,.TEXTOUT)
  1.  . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=""
  1.  Q
  1.  ;
  1.  ;====================================================
  1. OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
  1.  ;maintenance output. The VPOV information is:  DATE, ICD9 IEN,
  1.  ;ICD9 CODE, MODIFIER, PROVIDER NARRATIVE.
  1.  N CODE,D0,PROC,EM,ICD0P,ICD0ZN,IND,JND,NIN,NOUT,PN,RANK
  1.  N TEMP,TEXTIN,TEXTOUT,VDATE
  1.  S NLINES=NLINES+1
  1.  S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Hospitalization Procedure:"
  1.  S IND=0
  1.  F  S IND=$O(OCCLIST(IND)) Q:IND=""  D
  1.  . S VDATE=IFIEVAL(IND,"DATE")
  1.  . S TEMP=$$EDATE^PXRMDATE(VDATE)
  1.  . S ICD0P=IFIEVAL(IND,"CODE")
  1.  . S CODESYS=IFIEVAL(IND,"CODESYS")
  1.  . S D0=$G(^AUPNVPRC(IFIEVAL(IND,"DAS"),0))
  1.  . S PN=$P(D0,U,4)
  1.  . I PN="" S PN="MISSING"
  1.  .E  S PN=$P($G(^AUTNPOV(PN,0)),U,1)
  1.  . S ICD0ZN=$$ICDOP^ICDEX(ICD0P,VDATE,CODESYS,"I")
  1.  . S CODE=$P(ICD0ZN,U,2)
  1.  . S PROC=$P(ICD0ZN,U,5)
  1.  . S TEMP=TEMP_" "_CODE_" "_PROC_" data node: "
  1.  . S TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_"  "_CODE_" ("_CODESYS_")"
  1.  . S TEXTIN(2)=" Prov. Narr. - "_PN
  1.  . D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,2,.TEXTIN,.NOUT,.TEXTOUT)
  1.  . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1.  S NLINES=NLINES+1,TEXT(NLINES)=""
  1.  Q
  1.  ;