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