BPXRMPRC ; IHS/MSC/MGH - Code to handle V PROCEDURE ;03-Mar-2016 11:29;DU
;;2.0;CLINICAL REMINDERS;**1001,1007**;Feb 04, 2005;Build 12
;
;====================================================
FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
N DAS,DATE,DS,EDTT,ICDP,IND,NFOUND,NODE,NNODE,TE,TLIST,TS
N TDATE,TIND,CODESYS
I $G(^PXRMINDX(9000010.08,"DATE BUILT"))="" D Q
. D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.08)
I '$D(^PXRMINDX(9000010.08,"PPI",DFN)) Q
;S NNODE=+$P($G(TAXARR("PDS",9000010.08,80.1)),U,2)
;I NNODE=0 Q
S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
S TS=$O(TAXARR(80.1,""))-1
S TE=$O(TAXARR(80.1,""),-1)
S NFOUND=0
;F IND=1:1:NNODE D
;S NODE=TAXARR("PDS",9000010.08,80.1,IND)
;S ICDP=TS
S ICDP=""
S NODE=""
;IHS/MSC/MGH Section redone for ICD-10 codes patch 1007
F S NODE=$O(^PXRMINDX(9000010.08,"PPI",DFN,NODE)) Q:NODE="" D
.F CODESYS="10P","ICP" D
..S CODE=""
..F S CODE=$O(TAXARR("AE",CODESYS,CODE)) Q:CODE="" D
... S ICDP=TAXARR("AE",CODESYS,CODE)
... ;IHS/MSC/MGH changed 1007 to get IEN of code
... I CODESYS="10P" S ICDP=+$$CODEN^ICDEX(CODE,80.1)
... I '$D(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP)) Q
... S DATE=DS
... 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
.... S DAS=$O(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP,DATE,""))
.... S NFOUND=NFOUND+1
.... S TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_ICDP_U_NODE
.... I NFOUND>NGET D
..... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
..... K TLIST(TDATE,TIND)
;Return up to NGET of the most recent entries.
S NFOUND=0
S DATE=""
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.08)=TLIST(DATE,IND)
Q
;
;====================================================
GETDATA(DAS,FIEVT) ;Return data for a specified V POV entry.
;DBIA #4250
D VPRC^BPXRMPX(DAS,.FIEVT)
Q
;
;====================================================
GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V PROCEDURE entries.
N DAS,DATE,DFN,DS,ICDP,IND,NFOUND,NODE,NNODE,TEMP,TLIST
I $G(^PXRMINDX(9000010.08,"DATE BUILT"))="" D Q
. D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.08)
S TLIST="GPLIST_BPXRMPRC"
S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S NNODE=+$P($G(TAXARR("PDS",9000010.08,80.1)),U,2)
I NNODE=0 Q
S ICDP=""
F S ICDP=$O(TAXARR(80.1,ICDP)) Q:(ICDP="") D
. I '$D(^PXRMINDX(9000010.08,"IPP",ICDP)) Q
. F IND=1:1:NNODE D
.. S NODE=TAXARR("PDS",9000010.08,80.1,IND)
.. I '$D(^PXRMINDX(9000010.08,"IPP",ICDP,NODE)) Q
.. S DFN=0
.. F S DFN=$O(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN)) Q:DFN="" D
... S DATE=DS
... F S DATE=+$O(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT) D
.... S DAS=$O(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN,DATE,""))
.... S ^TMP($J,TLIST,DFN,DATE,DAS)=ICDP_U_"ICD0"_U_NODE
;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 NFOUND=0
. S DATE=""
. 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 ICDP=$P(TEMP,U,1)
... S ^TMP($J,PLIST,1,DFN,NFOUND,9000010.08)=DAS_U_DATE_U_TEMP
K ^TMP($J,TLIST)
Q
;
;====================================================
MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
N CODE,D0,PROC,EM,ICD0P,ICD0ZN,ICD9ZN,IND,JND,NAME,NIN,NOUT,PN,RANK
N TEMP,TEXTIN,TEXTOUT,VDATE
S NAME="Procedure = "
S IND=0
F S IND=$O(OCCLIST(IND)) Q:IND="" D
. S VDATE=IFIEVAL(IND,"DATE")
. S ICD0P=IFIEVAL(IND,"CODEP")
. S D0=$G(^AUPNVPRC(IFIEVAL(IND,"DAS"),0))
. S ICD9ZN=$$ICDOP^ICDCODE(ICD0P,VDATE)
. S CODE=$P(ICD0ZN,U,2)
. S PROC=$P(ICD0ZN,U,5)
. S TEMP=NAME_PROC_" ("_$$EDATE^PXRMDATE(VDATE)_")"
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,4,.TEXTIN,.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. The VPOV information is: DATE, ICD9 IEN,
;ICD9 CODE, MODIFIER, PROVIDER NARRATIVE.
N CODE,D0,PROC,EM,ICD0P,ICD0ZN,IND,JND,NIN,NOUT,PN,RANK
N TEMP,TEXTIN,TEXTOUT,VDATE
S NLINES=NLINES+1
S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Hospitalization Procedure:"
S IND=0
F S IND=$O(OCCLIST(IND)) Q:IND="" D
. S VDATE=IFIEVAL(IND,"DATE")
. S TEMP=$$EDATE^PXRMDATE(VDATE)
. S ICD0P=IFIEVAL(IND,"CODE")
. S CODESYS=IFIEVAL(IND,"CODESYS")
. S D0=$G(^AUPNVPRC(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 ICD0ZN=$$ICDOP^ICDEX(ICD0P,VDATE,CODESYS,"I")
. S CODE=$P(ICD0ZN,U,2)
. S PROC=$P(ICD0ZN,U,5)
. S TEMP=TEMP_" "_CODE_" "_PROC_" data node: "
. S TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_" "_CODE_" ("_CODESYS_")"
. S TEXTIN(2)=" Prov. Narr. - "_PN
. D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,2,.TEXTIN,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
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
+2 ;
+3 ;====================================================
FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
+1 NEW DAS,DATE,DS,EDTT,ICDP,IND,NFOUND,NODE,NNODE,TE,TLIST,TS
+2 NEW TDATE,TIND,CODESYS
+3 IF $GET(^PXRMINDX(9000010.08,"DATE BUILT"))=""
Begin DoDot:1
+4 DO NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.08)
End DoDot:1
QUIT
+5 IF '$DATA(^PXRMINDX(9000010.08,"PPI",DFN))
QUIT
+6 ;S NNODE=+$P($G(TAXARR("PDS",9000010.08,80.1)),U,2)
+7 ;I NNODE=0 Q
+8 SET EDTT=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+9 SET DS=$SELECT(SDIR=+1:BDT-.000001,1:EDTT)
+10 SET TS=$ORDER(TAXARR(80.1,""))-1
+11 SET TE=$ORDER(TAXARR(80.1,""),-1)
+12 SET NFOUND=0
+13 ;F IND=1:1:NNODE D
+14 ;S NODE=TAXARR("PDS",9000010.08,80.1,IND)
+15 ;S ICDP=TS
+16 SET ICDP=""
+17 SET NODE=""
+18 ;IHS/MSC/MGH Section redone for ICD-10 codes patch 1007
+19 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.08,"PPI",DFN,NODE))
IF NODE=""
QUIT
Begin DoDot:1
+20 FOR CODESYS="10P","ICP"
Begin DoDot:2
+21 SET CODE=""
+22 FOR
SET CODE=$ORDER(TAXARR("AE",CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:3
+23 SET ICDP=TAXARR("AE",CODESYS,CODE)
+24 ;IHS/MSC/MGH changed 1007 to get IEN of code
+25 IF CODESYS="10P"
SET ICDP=+$$CODEN^ICDEX(CODE,80.1)
+26 IF '$DATA(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP))
QUIT
+27 SET DATE=DS
+28 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP,DATE),SDIR)
IF $SELECT(DATE=0
QUIT
Begin DoDot:4
+29 SET DAS=$ORDER(^PXRMINDX(9000010.08,"PPI",DFN,NODE,ICDP,DATE,""))
+30 SET NFOUND=NFOUND+1
+31 SET TLIST(DATE,NFOUND)=DAS_U_DATE_U_CODESYS_U_ICDP_U_NODE
+32 IF NFOUND>NGET
Begin DoDot:5
+33 SET TDATE=$ORDER(TLIST(""),-SDIR)
SET TIND=$ORDER(TLIST(TDATE,""))
+34 KILL TLIST(TDATE,TIND)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;Return up to NGET of the most recent entries.
+36 SET NFOUND=0
+37 SET DATE=""
+38 FOR
SET DATE=$ORDER(TLIST(DATE),SDIR)
IF (DATE="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+39 SET IND=0
+40 FOR
SET IND=$ORDER(TLIST(DATE,IND))
IF (IND="")!(NFOUND=NGET)
QUIT
Begin DoDot:2
+41 SET NFOUND=NFOUND+1
+42 SET FLIST(DATE,NFOUND,9000010.08)=TLIST(DATE,IND)
End DoDot:2
End DoDot:1
+43 QUIT
+44 ;
+45 ;====================================================
GETDATA(DAS,FIEVT) ;Return data for a specified V POV entry.
+1 ;DBIA #4250
+2 DO VPRC^BPXRMPX(DAS,.FIEVT)
+3 QUIT
+4 ;
+5 ;====================================================
GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V PROCEDURE entries.
+1 NEW DAS,DATE,DFN,DS,ICDP,IND,NFOUND,NODE,NNODE,TEMP,TLIST
+2 IF $GET(^PXRMINDX(9000010.08,"DATE BUILT"))=""
Begin DoDot:1
+3 DO NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.08)
End DoDot:1
QUIT
+4 SET TLIST="GPLIST_BPXRMPRC"
+5 SET DS=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+6 SET NNODE=+$PIECE($GET(TAXARR("PDS",9000010.08,80.1)),U,2)
+7 IF NNODE=0
QUIT
+8 SET ICDP=""
+9 FOR
SET ICDP=$ORDER(TAXARR(80.1,ICDP))
IF (ICDP="")
QUIT
Begin DoDot:1
+10 IF '$DATA(^PXRMINDX(9000010.08,"IPP",ICDP))
QUIT
+11 FOR IND=1:1:NNODE
Begin DoDot:2
+12 SET NODE=TAXARR("PDS",9000010.08,80.1,IND)
+13 IF '$DATA(^PXRMINDX(9000010.08,"IPP",ICDP,NODE))
QUIT
+14 SET DFN=0
+15 FOR
SET DFN=$ORDER(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN))
IF DFN=""
QUIT
Begin DoDot:3
+16 SET DATE=DS
+17 FOR
SET DATE=+$ORDER(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN,DATE),-1)
IF (DATE=0)!(DATE<BDT)
QUIT
Begin DoDot:4
+18 SET DAS=$ORDER(^PXRMINDX(9000010.08,"IPP",ICDP,NODE,DFN,DATE,""))
+19 SET ^TMP($JOB,TLIST,DFN,DATE,DAS)=ICDP_U_"ICD0"_U_NODE
End DoDot:4
End DoDot:3
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 NFOUND=0
+24 SET DATE=""
+25 FOR
SET DATE=$ORDER(^TMP($JOB,TLIST,DFN,DATE),-1)
IF (DATE="")!(NFOUND=NOCC)
QUIT
Begin DoDot:2
+26 SET DAS=""
+27 FOR
SET DAS=$ORDER(^TMP($JOB,TLIST,DFN,DATE,DAS))
IF DAS=""
QUIT
Begin DoDot:3
+28 SET NFOUND=NFOUND+1
+29 SET TEMP=^TMP($JOB,TLIST,DFN,DATE,DAS)
+30 SET ICDP=$PIECE(TEMP,U,1)
+31 SET ^TMP($JOB,PLIST,1,DFN,NFOUND,9000010.08)=DAS_U_DATE_U_TEMP
End DoDot:3
End DoDot:2
End DoDot:1
+32 KILL ^TMP($JOB,TLIST)
+33 QUIT
+34 ;
+35 ;====================================================
MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW CODE,D0,PROC,EM,ICD0P,ICD0ZN,ICD9ZN,IND,JND,NAME,NIN,NOUT,PN,RANK
+2 NEW TEMP,TEXTIN,TEXTOUT,VDATE
+3 SET NAME="Procedure = "
+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 ICD0P=IFIEVAL(IND,"CODEP")
+8 SET D0=$GET(^AUPNVPRC(IFIEVAL(IND,"DAS"),0))
+9 SET ICD9ZN=$$ICDOP^ICDCODE(ICD0P,VDATE)
+10 SET CODE=$PIECE(ICD0ZN,U,2)
+11 SET PROC=$PIECE(ICD0ZN,U,5)
+12 SET TEMP=NAME_PROC_" ("_$$EDATE^PXRMDATE(VDATE)_")"
+13 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,4,.TEXTIN,.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. The VPOV information is: DATE, ICD9 IEN,
+2 ;ICD9 CODE, MODIFIER, PROVIDER NARRATIVE.
+3 NEW CODE,D0,PROC,EM,ICD0P,ICD0ZN,IND,JND,NIN,NOUT,PN,RANK
+4 NEW TEMP,TEXTIN,TEXTOUT,VDATE
+5 SET NLINES=NLINES+1
+6 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Hospitalization Procedure:"
+7 SET IND=0
+8 FOR
SET IND=$ORDER(OCCLIST(IND))
IF IND=""
QUIT
Begin DoDot:1
+9 SET VDATE=IFIEVAL(IND,"DATE")
+10 SET TEMP=$$EDATE^PXRMDATE(VDATE)
+11 SET ICD0P=IFIEVAL(IND,"CODE")
+12 SET CODESYS=IFIEVAL(IND,"CODESYS")
+13 SET D0=$GET(^AUPNVPRC(IFIEVAL(IND,"DAS"),0))
+14 SET PN=$PIECE(D0,U,4)
+15 IF PN=""
SET PN="MISSING"
+16 IF '$TEST
SET PN=$PIECE($GET(^AUTNPOV(PN,0)),U,1)
+17 SET ICD0ZN=$$ICDOP^ICDEX(ICD0P,VDATE,CODESYS,"I")
+18 SET CODE=$PIECE(ICD0ZN,U,2)
+19 SET PROC=$PIECE(ICD0ZN,U,5)
+20 SET TEMP=TEMP_" "_CODE_" "_PROC_" data node: "
+21 SET TEXTIN(1)=$$EDATE^PXRMDATE(VDATE)_" "_CODE_" ("_CODESYS_")"
+22 SET TEXTIN(2)=" Prov. Narr. - "_PN
+23 DO FORMAT^PXRMTEXT(INDENT+2,PXRMRM,2,.TEXTIN,.NOUT,.TEXTOUT)
+24 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:1
+25 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+26 QUIT
+27 ;
