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

PXRMVPOV.m

Go to the documentation of this file. 
  1. PXRMVPOV ; SLC/PKR - Code to handle V POV ;31-Dec-2015 10:16;DU
  1.  ;;2.0;CLINICAL REMINDERS;**4,26,1005,1006**;Feb 04, 2005;Build 5
  1.  ;
  1.  ;====================================================
  1. FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
  1.  N CODESYS,DATE,DS,EDTT,IND,NFOUND,NNODES,TLIST
  1.  S NNODES=TAXARR("APDS",9000010.07,"NNODES")
  1.  I NNODES=0 Q
  1.  I $G(^PXRMINDX(9000010.07,"DATE BUILT"))="" D  Q
  1.  . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.07)
  1.  S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1.  S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(TAXARR("AE",CODESYS)) Q:CODESYS=""  D
  1.  . ;Patch 1005 changed for 10D types
  1.  . I ((CODESYS="ICD")!(CODESYS="10D")),$D(^PXRMINDX(9000010.07,"PPI",DFN)) D FPDICD9(DFN,.TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,.TLIST,CODESYS)
  1.  . I ((CODESYS'="ICD")&(CODESYS'="10D")),$D(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN)) D FPDCSYS(DFN,CODESYS,.TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,.TLIST)
  1.  ;Return up to NGET entries.
  1.  S DATE="",NFOUND=0
  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.07)=TLIST(DATE,IND)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. FPDCSYS(DFN,CODESYS,TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,TLIST) ;Find data for
  1.  ;a patient in coding systems other than ICD-9.
  1.  N CODE,DAS,DATE,IND,NFOUND,NODE,TDATE,TIND
  1.  I '$D(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN)) Q
  1.  S NFOUND=0
  1.  F IND=1:1:NNODES D
  1.  . S NODE=TAXARR("APDS",9000010.07,IND)
  1.  . I '$D(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE)) Q
  1.  . S CODE=""
  1.  . F  S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE=""  D
  1.  .. I '$D(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE,CODE)) Q
  1.  .. S DATE=DS
  1.  .. F  S DATE=+$O(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE,CODE,DATE),SDIR) Q:$S(DATE=0:1,DATE<BDT:1,DATE>EDTT:1,1:0)  D
  1.  ... S DAS=$O(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE,CODE,DATE,""))
  1.  ... S NFOUND=NFOUND+1
  1.  ... S TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE_U_NODE
  1.  ... I NFOUND>NGET D
  1.  .... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
  1.  .... K TLIST(TDATE,TIND)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. FPDICD9(DFN,TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,TLIST,CODESYS) ;Find ICD-9 data for a
  1.  ;patient.
  1.  N CODE,CODEP,DAS,DATE,IND,NFOUND,NODE,TDATE,TIND
  1.  I '$D(^PXRMINDX(9000010.07,"PPI",DFN)) Q
  1.  S NFOUND=0
  1.  F IND=1:1:NNODES D
  1.  . S NODE=TAXARR("APDS",9000010.07,IND)
  1.  . I '$D(^PXRMINDX(9000010.07,"PPI",DFN,NODE)) Q
  1.  . S CODE=""
  1.  . ;IHS/MSC/MGH  changed for coding system
  1.  . F  S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE=""  D
  1.  .. S CODEP=TAXARR("AE",CODESYS,CODE)
  1.  .. ;IHS/MSC/MGH changed 1006 to get IEN of code
  1.  .. I CODESYS="10D" S CODEP=+$$CODEN^ICDEX(CODE,80)
  1.  .. I '$D(^PXRMINDX(9000010.07,"PPI",DFN,NODE,CODEP)) Q
  1.  .. S DATE=DS
  1.  .. F  S DATE=+$O(^PXRMINDX(9000010.07,"PPI",DFN,NODE,CODEP,DATE),SDIR) Q:$S(DATE=0:1,DATE<BDT:1,DATE>EDTT:1,1:0)  D
  1.  ... S DAS=$O(^PXRMINDX(9000010.07,"PPI",DFN,NODE,CODEP,DATE,""))
  1.  ... S NFOUND=NFOUND+1
  1.  ... S TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE_U_NODE
  1.  ... I NFOUND>NGET D
  1.  .... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
  1.  .... K TLIST(TDATE,TIND)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. GETDATA(DAS,FIEVT) ;Return data for a specified V POV entry.
  1.  ;DBIA #4250
  1.  D VPOV^PXPXRM(DAS,.FIEVT)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V POV entries.
  1.  N CODE,CODEP,CODESYS,DAS,DATE,DFN,DS,IND,NFOUND,NODE,NNODES,TEMP,TLIST
  1.  S NNODES=TAXARR("APDS",9000010.07,"NNODES")
  1.  I NNODES=0 Q
  1.  I $G(^PXRMINDX(9000010.07,"DATE BUILT"))="" D  Q
  1.  . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.07)
  1.  S TLIST="GPLIST_PXRMVPOV"
  1.  K ^TMP($J,TLIST)
  1.  S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(TAXARR("AE",CODESYS)) Q:CODESYS=""  D
  1.  . S CODE=""
  1.  . F  S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE=""  D
  1.  .. ;IHS/MSC/MGH changes for ICD-10
  1.  .. I (CODESYS="ICD")!(CODESYS="10D") D
  1.  ... S CODEP=TAXARR("AE",CODESYS,CODE)
  1.  ... ;IHS/MSC/MGH changed 1006 to get IEN of code
  1.  ... I CODESYS="10D" S CODEP=+$$CODEN^ICDEX(CODE,80)
  1.  ... I $D(^PXRMINDX(9000010.07,"IPP",CODEP)) D GPLICD9(CODE,CODEP,.TAXARR,NNODES,BDT,DS,TLIST,CODESYS)
  1.  .. I (CODESYS'="ICD"),$D(^PXRMINDX(9000010.07,CODESYS,"IPP",CODE)) D GPLCSYS(CODESYS,CODE,.TAXARR,NNODES,BDT,DS,TLIST)
  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 DATE="",NFOUND=0
  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 ^TMP($J,PLIST,1,DFN,NFOUND,9000010.07)=DAS_U_DATE_U_TEMP
  1.  K ^TMP($J,TLIST)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. GPLCSYS(CODESYS,CODE,TAXARR,NNODES,BDT,DS,TLIST) ;Build a patient list for V POV
  1.  ;entries for coding systems other than ICD-9.
  1.  N DAS,DATE,DFN,IND,NODE
  1.  F IND=1:1:NNODES D
  1.  . S NODE=TAXARR("APDS",9000010.07,IND)
  1.  . I '$D(^PXRMINDX(9000010.07,CODESYS,"IPP",CODE,NODE)) Q
  1.  . S DFN=0
  1.  . F  S DFN=$O(^PXRMINDX(9000010.07,CODESYS,"IPP",CODE,NODE,DFN)) Q:DFN=""  D
  1.  .. S DATE=DS
  1.  .. F  S DATE=+$O(^PXRMINDX(9000010.07,"IPP",CODE,NODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)  D
  1.  ... S DAS=$O(^PXRMINDX(9000010.07,"IPP",CODE,NODE,DFN,DATE,""))
  1.  ... S ^TMP($J,TLIST,DFN,DATE,DAS)=CODESYS_U_CODE_U_NODE
  1.  Q
  1.  ;
  1.  ;====================================================
  1. GPLICD9(CODE,CODEP,TAXARR,NNODES,BDT,DS,TLIST,CODESYS) ;Build a patient list for
  1.  ;V POV entries using ICD-9 codes.
  1.  N DAS,DATE,DFN,IND,NODE
  1.  F IND=1:1:NNODES D
  1.  . S NODE=TAXARR("APDS",9000010.07,IND)
  1.  . I '$D(^PXRMINDX(9000010.07,"IPP",CODEP,NODE)) Q
  1.  . S DFN=0
  1.  . F  S DFN=$O(^PXRMINDX(9000010.07,"IPP",CODEP,NODE,DFN)) Q:DFN=""  D
  1.  .. S DATE=DS
  1.  .. F  S DATE=+$O(^PXRMINDX(9000010.07,"IPP",CODEP,NODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)  D
  1.  ... S DAS=$O(^PXRMINDX(9000010.07,"IPP",CODEP,NODE,DFN,DATE,""))
  1.  ... S ^TMP($J,TLIST,DFN,DATE,DAS)=CODESYS_U_CODE_U_NODE
  1.  Q
  1.  ;
  1.  ;====================================================
  1. MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
  1.  N CDATA,CODE,CODESYS,EM,IND,JND,NAME,NIN,NOUT
  1.  N PN,RESULT,TEMP,TEXTOUT,VDATE
  1.  S NAME="Encounter Diagnosis = "
  1.  S IND=0
  1.  F  S IND=$O(OCCLIST(IND)) Q:IND=""  D
  1.  . S VDATE=IFIEVAL(IND,"DATE")
  1.  . S CODE=IFIEVAL(IND,"CODE")
  1.  . S CODESYS=IFIEVAL(IND,"CODESYS")
  1.  . K CDATA
  1.  . ;DBIA #5679
  1.  . S RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
  1.  . S TEMP=NAME_$P(CDATA("LEX",1),U,2)_" ("_$$EDATE^PXRMDATE(VDATE)_")"
  1.  . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.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.
  1.  N CDATA,CODE,CODESYS,CODESYSN,D0,EM,IND,JND
  1.  N NOUT,PN,RANK,RESULT,TEXTIN,TEXTOUT,VDATE
  1.  S NLINES=NLINES+1
  1.  S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Encounter Diagnosis:"
  1.  S IND=0
  1.  F  S IND=$O(OCCLIST(IND)) Q:IND=""  D
  1.  . S VDATE=IFIEVAL(IND,"DATE")
  1.  . S CODE=IFIEVAL(IND,"CODE")
  1.  . S CODESYS=IFIEVAL(IND,"CODESYS")
  1.  .;DBIA #5679
  1.  . I '$D(CODESYSN(CODESYS)) S CODESYSN(CODESYS)=$P($$CSYS^LEXU(CODESYS),U,4)
  1.  . K CDATA
  1.  . ;DBIA #5679
  1.  . S RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
  1.  . S D0=$G(^AUPNVPOV(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 RANK=IFIEVAL(IND,"PRIMARY/SECONDARY")
  1.  . S RANK=$$EXTERNAL^DILFD(9000010.07,.12,"",RANK,.EM)
  1.  . S TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_"  "_CODE_" ("_CODESYSN(CODESYS)_")"
  1.  . S TEXTIN(2)=$P(CDATA("LEX",1),U,2)
  1.  . S TEXTIN(3)=" rank: "_RANK_"\\"
  1.  . ;Get the new provider narrative IHS/MSC/MGH 1005
  1.  . I PN["|" D  ; no vertical equals no snomed desc id
  1.  . . NEW SDI,SDIT,SNTXT
  1.  . . S SDI=$P(PN,"|",2)  ;snomed descriptive id is in piece 2
  1.  . . S SDIT=$P($$DESC^BSTSAPI(SDI_"^^1"),U,2)
  1.  . . I SDIT="" S SNTXT="*"_$P(PN,"|",1)
  1.  . . E  S SNTXT=SDIT_" | "_$P(PN,"|",1)
  1.  . . S TEXTIN(4)=" Prov. Narr. - "_SNTXT
  1.  . E  S TEXTIN(4)="Prov. Narr. - "_PN
  1.  . D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,4,.TEXTIN,.NOUT,.TEXTOUT)
  1.  . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
  1.  . I IFIEVAL(IND,"COMMENTS")'="" D
  1.  .. S TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
  1.  .. D FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.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.  ;