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
;
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
+2 ;
+3 ;====================================================
FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
+1 NEW CODESYS,DATE,DS,EDTT,IND,NFOUND,NNODES,TLIST
+2 SET NNODES=TAXARR("APDS",9000010.07,"NNODES")
+3 IF NNODES=0
QUIT
+4 IF $GET(^PXRMINDX(9000010.07,"DATE BUILT"))=""
Begin DoDot:1
+5 DO NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.07)
End DoDot:1
QUIT
+6 SET EDTT=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+7 SET DS=$SELECT(SDIR=+1:BDT-.000001,1:EDTT)
+8 SET CODESYS=""
+9 FOR
SET CODESYS=$ORDER(TAXARR("AE",CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:1
+10 ;Patch 1005 changed for 10D types
+11 IF ((CODESYS="ICD")!(CODESYS="10D"))
IF $DATA(^PXRMINDX(9000010.07,"PPI",DFN))
DO FPDICD9(DFN,.TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,.TLIST,CODESYS)
+12 IF ((CODESYS'="ICD")&(CODESYS'="10D"))
IF $DATA(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN))
DO FPDCSYS(DFN,CODESYS,.TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,.TLIST)
End DoDot:1
+13 ;Return up to NGET entries.
+14 SET DATE=""
SET NFOUND=0
+15 FOR
SET DATE=$ORDER(TLIST(DATE),SDIR)
IF (DATE="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+16 SET IND=0
+17 FOR
SET IND=$ORDER(TLIST(DATE,IND))
IF (IND="")!(NFOUND=NGET)
QUIT
Begin DoDot:2
+18 SET NFOUND=NFOUND+1
+19 SET FLIST(DATE,NFOUND,9000010.07)=TLIST(DATE,IND)
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
+22 ;====================================================
FPDCSYS(DFN,CODESYS,TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,TLIST) ;Find data for
+1 ;a patient in coding systems other than ICD-9.
+2 NEW CODE,DAS,DATE,IND,NFOUND,NODE,TDATE,TIND
+3 IF '$DATA(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN))
QUIT
+4 SET NFOUND=0
+5 FOR IND=1:1:NNODES
Begin DoDot:1
+6 SET NODE=TAXARR("APDS",9000010.07,IND)
+7 IF '$DATA(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE))
QUIT
+8 SET CODE=""
+9 FOR
SET CODE=$ORDER(TAXARR("AE",CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:2
+10 IF '$DATA(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE,CODE))
QUIT
+11 SET DATE=DS
+12 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE,CODE,DATE),SDIR)
IF $SELECT(DATE=0
QUIT
Begin DoDot:3
+13 SET DAS=$ORDER(^PXRMINDX(9000010.07,CODESYS,"PPI",DFN,NODE,CODE,DATE,""))
+14 SET NFOUND=NFOUND+1
+15 SET TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE_U_NODE
+16 IF NFOUND>NGET
Begin DoDot:4
+17 SET TDATE=$ORDER(TLIST(""),-SDIR)
SET TIND=$ORDER(TLIST(TDATE,""))
+18 KILL TLIST(TDATE,TIND)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;====================================================
FPDICD9(DFN,TAXARR,NNODES,NGET,BDT,EDTT,DS,SDIR,TLIST,CODESYS) ;Find ICD-9 data for a
+1 ;patient.
+2 NEW CODE,CODEP,DAS,DATE,IND,NFOUND,NODE,TDATE,TIND
+3 IF '$DATA(^PXRMINDX(9000010.07,"PPI",DFN))
QUIT
+4 SET NFOUND=0
+5 FOR IND=1:1:NNODES
Begin DoDot:1
+6 SET NODE=TAXARR("APDS",9000010.07,IND)
+7 IF '$DATA(^PXRMINDX(9000010.07,"PPI",DFN,NODE))
QUIT
+8 SET CODE=""
+9 ;IHS/MSC/MGH changed for coding system
+10 FOR
SET CODE=$ORDER(TAXARR("AE",CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:2
+11 SET CODEP=TAXARR("AE",CODESYS,CODE)
+12 ;IHS/MSC/MGH changed 1006 to get IEN of code
+13 IF CODESYS="10D"
SET CODEP=+$$CODEN^ICDEX(CODE,80)
+14 IF '$DATA(^PXRMINDX(9000010.07,"PPI",DFN,NODE,CODEP))
QUIT
+15 SET DATE=DS
+16 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,NODE,CODEP,DATE),SDIR)
IF $SELECT(DATE=0
QUIT
Begin DoDot:3
+17 SET DAS=$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,NODE,CODEP,DATE,""))
+18 SET NFOUND=NFOUND+1
+19 SET TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_CODE_U_NODE
+20 IF NFOUND>NGET
Begin DoDot:4
+21 SET TDATE=$ORDER(TLIST(""),-SDIR)
SET TIND=$ORDER(TLIST(TDATE,""))
+22 KILL TLIST(TDATE,TIND)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
+25 ;====================================================
GETDATA(DAS,FIEVT) ;Return data for a specified V POV entry.
+1 ;DBIA #4250
+2 DO VPOV^PXPXRM(DAS,.FIEVT)
+3 QUIT
+4 ;
+5 ;====================================================
GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V POV entries.
+1 NEW CODE,CODEP,CODESYS,DAS,DATE,DFN,DS,IND,NFOUND,NODE,NNODES,TEMP,TLIST
+2 SET NNODES=TAXARR("APDS",9000010.07,"NNODES")
+3 IF NNODES=0
QUIT
+4 IF $GET(^PXRMINDX(9000010.07,"DATE BUILT"))=""
Begin DoDot:1
+5 DO NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.07)
End DoDot:1
QUIT
+6 SET TLIST="GPLIST_PXRMVPOV"
+7 KILL ^TMP($JOB,TLIST)
+8 SET DS=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+9 SET CODESYS=""
+10 FOR
SET CODESYS=$ORDER(TAXARR("AE",CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:1
+11 SET CODE=""
+12 FOR
SET CODE=$ORDER(TAXARR("AE",CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:2
+13 ;IHS/MSC/MGH changes for ICD-10
+14 IF (CODESYS="ICD")!(CODESYS="10D")
Begin DoDot:3
+15 SET CODEP=TAXARR("AE",CODESYS,CODE)
+16 ;IHS/MSC/MGH changed 1006 to get IEN of code
+17 IF CODESYS="10D"
SET CODEP=+$$CODEN^ICDEX(CODE,80)
+18 IF $DATA(^PXRMINDX(9000010.07,"IPP",CODEP))
DO GPLICD9(CODE,CODEP,.TAXARR,NNODES,BDT,DS,TLIST,CODESYS)
End DoDot:3
+19 IF (CODESYS'="ICD")
IF $DATA(^PXRMINDX(9000010.07,CODESYS,"IPP",CODE))
DO GPLCSYS(CODESYS,CODE,.TAXARR,NNODES,BDT,DS,TLIST)
End DoDot:2
End DoDot:1
+20 ;Return up to NOCC of the most recent entries for each patient.
+21 SET DFN=0
+22 FOR
SET DFN=$ORDER(^TMP($JOB,TLIST,DFN))
IF DFN=""
QUIT
Begin DoDot:1
+23 SET DATE=""
SET NFOUND=0
+24 FOR
SET DATE=$ORDER(^TMP($JOB,TLIST,DFN,DATE),-1)
IF (DATE="")!(NFOUND=NOCC)
QUIT
Begin DoDot:2
+25 SET DAS=""
+26 FOR
SET DAS=$ORDER(^TMP($JOB,TLIST,DFN,DATE,DAS))
IF DAS=""
QUIT
Begin DoDot:3
+27 SET NFOUND=NFOUND+1
+28 SET TEMP=^TMP($JOB,TLIST,DFN,DATE,DAS)
+29 SET ^TMP($JOB,PLIST,1,DFN,NFOUND,9000010.07)=DAS_U_DATE_U_TEMP
End DoDot:3
End DoDot:2
End DoDot:1
+30 KILL ^TMP($JOB,TLIST)
+31 QUIT
+32 ;
+33 ;====================================================
GPLCSYS(CODESYS,CODE,TAXARR,NNODES,BDT,DS,TLIST) ;Build a patient list for V POV
+1 ;entries for coding systems other than ICD-9.
+2 NEW DAS,DATE,DFN,IND,NODE
+3 FOR IND=1:1:NNODES
Begin DoDot:1
+4 SET NODE=TAXARR("APDS",9000010.07,IND)
+5 IF '$DATA(^PXRMINDX(9000010.07,CODESYS,"IPP",CODE,NODE))
QUIT
+6 SET DFN=0
+7 FOR
SET DFN=$ORDER(^PXRMINDX(9000010.07,CODESYS,"IPP",CODE,NODE,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+8 SET DATE=DS
+9 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.07,"IPP",CODE,NODE,DFN,DATE),-1)
IF (DATE=0)!(DATE<BDT)
QUIT
Begin DoDot:3
+10 SET DAS=$ORDER(^PXRMINDX(9000010.07,"IPP",CODE,NODE,DFN,DATE,""))
+11 SET ^TMP($JOB,TLIST,DFN,DATE,DAS)=CODESYS_U_CODE_U_NODE
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;====================================================
GPLICD9(CODE,CODEP,TAXARR,NNODES,BDT,DS,TLIST,CODESYS) ;Build a patient list for
+1 ;V POV entries using ICD-9 codes.
+2 NEW DAS,DATE,DFN,IND,NODE
+3 FOR IND=1:1:NNODES
Begin DoDot:1
+4 SET NODE=TAXARR("APDS",9000010.07,IND)
+5 IF '$DATA(^PXRMINDX(9000010.07,"IPP",CODEP,NODE))
QUIT
+6 SET DFN=0
+7 FOR
SET DFN=$ORDER(^PXRMINDX(9000010.07,"IPP",CODEP,NODE,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+8 SET DATE=DS
+9 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.07,"IPP",CODEP,NODE,DFN,DATE),-1)
IF (DATE=0)!(DATE<BDT)
QUIT
Begin DoDot:3
+10 SET DAS=$ORDER(^PXRMINDX(9000010.07,"IPP",CODEP,NODE,DFN,DATE,""))
+11 SET ^TMP($JOB,TLIST,DFN,DATE,DAS)=CODESYS_U_CODE_U_NODE
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;====================================================
MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW CDATA,CODE,CODESYS,EM,IND,JND,NAME,NIN,NOUT
+2 NEW PN,RESULT,TEMP,TEXTOUT,VDATE
+3 SET NAME="Encounter Diagnosis = "
+4 SET IND=0
+5 FOR
SET IND=$ORDER(OCCLIST(IND))
IF IND=""
QUIT
Begin DoDot:1
+6 SET VDATE=IFIEVAL(IND,"DATE")
+7 SET CODE=IFIEVAL(IND,"CODE")
+8 SET CODESYS=IFIEVAL(IND,"CODESYS")
+9 KILL CDATA
+10 ;DBIA #5679
+11 SET RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
+12 SET TEMP=NAME_$PIECE(CDATA("LEX",1),U,2)_" ("_$$EDATE^PXRMDATE(VDATE)_")"
+13 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+14 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:1
+15 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+16 QUIT
+17 ;
+18 ;====================================================
OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 NEW CDATA,CODE,CODESYS,CODESYSN,D0,EM,IND,JND
+3 NEW NOUT,PN,RANK,RESULT,TEXTIN,TEXTOUT,VDATE
+4 SET NLINES=NLINES+1
+5 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Encounter Diagnosis:"
+6 SET IND=0
+7 FOR
SET IND=$ORDER(OCCLIST(IND))
IF IND=""
QUIT
Begin DoDot:1
+8 SET VDATE=IFIEVAL(IND,"DATE")
+9 SET CODE=IFIEVAL(IND,"CODE")
+10 SET CODESYS=IFIEVAL(IND,"CODESYS")
+11 ;DBIA #5679
+12 IF '$DATA(CODESYSN(CODESYS))
SET CODESYSN(CODESYS)=$PIECE($$CSYS^LEXU(CODESYS),U,4)
+13 KILL CDATA
+14 ;DBIA #5679
+15 SET RESULT=$$CSDATA^LEXU(CODE,CODESYS,VDATE,.CDATA)
+16 SET D0=$GET(^AUPNVPOV(IFIEVAL(IND,"DAS"),0))
+17 SET PN=$PIECE(D0,U,4)
+18 IF PN=""
SET PN="MISSING"
+19 IF '$TEST
SET PN=$PIECE($GET(^AUTNPOV(PN,0)),U,1)
+20 SET RANK=IFIEVAL(IND,"PRIMARY/SECONDARY")
+21 SET RANK=$$EXTERNAL^DILFD(9000010.07,.12,"",RANK,.EM)
+22 SET TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_" "_CODE_" ("_CODESYSN(CODESYS)_")"
+23 SET TEXTIN(2)=$PIECE(CDATA("LEX",1),U,2)
+24 SET TEXTIN(3)=" rank: "_RANK_"\\"
+25 ;Get the new provider narrative IHS/MSC/MGH 1005
+26 ; no vertical equals no snomed desc id
IF PN["|"
Begin DoDot:2
+27 NEW SDI,SDIT,SNTXT
+28 ;snomed descriptive id is in piece 2
SET SDI=$PIECE(PN,"|",2)
+29 SET SDIT=$PIECE($$DESC^BSTSAPI(SDI_"^^1"),U,2)
+30 IF SDIT=""
SET SNTXT="*"_$PIECE(PN,"|",1)
+31 IF '$TEST
SET SNTXT=SDIT_" | "_$PIECE(PN,"|",1)
+32 SET TEXTIN(4)=" Prov. Narr. - "_SNTXT
End DoDot:2
+33 IF '$TEST
SET TEXTIN(4)="Prov. Narr. - "_PN
+34 DO FORMAT^PXRMTEXT(INDENT+2,PXRMRM,4,.TEXTIN,.NOUT,.TEXTOUT)
+35 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+36 IF IFIEVAL(IND,"COMMENTS")'=""
Begin DoDot:2
+37 SET TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
+38 DO FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+39 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:2
End DoDot:1
+40 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+41 QUIT
+42 ;
