236 lines
8.6 KiB
Mathematica
236 lines
8.6 KiB
Mathematica
PXRMLOCF ; SLC/PKR - Handle location findings. ;07/17/2006
|
|
;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|
;This routine is for location list patient findings.
|
|
;=================================================
|
|
ALL(FILENUM,DFN,PFINDPA,FIEVAL) ;Get all Visits with a location
|
|
;for a patient.
|
|
N BDT,CASESEN,COND,CONVAL,DAS,DATE,DONE,EDT,ENTYPE,FIEVD,HLOC
|
|
N ICOND,IND,NFOUND,NOCC
|
|
N SAVE,SDIR,TEMP,UCIFS,VDATE
|
|
;Set the finding search parameters.
|
|
D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
|
|
S SDIR=$S(NOCC<0:+1,1:-1)
|
|
S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
|
|
D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
|
|
S (DONE,NFOUND)=0
|
|
I SDIR=1 S VDATE=BDT-.0000001
|
|
I SDIR=-1 S VDATE=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
|
|
;DBIA 2028
|
|
F S VDATE=+$O(^AUPNVSIT("AET",DFN,VDATE),SDIR) Q:(VDATE=0)!(DONE) D
|
|
. I SDIR=1,VDATE>EDT S DONE=1 Q
|
|
. I SDIR=-1,VDATE<BDT S DONE=1 Q
|
|
. S HLOC=""
|
|
. F S HLOC=$O(^AUPNVSIT("AET",DFN,VDATE,HLOC)) Q:(HLOC="")!(DONE) D
|
|
.. S ENTYPE=""
|
|
.. F S ENTYPE=$O(^AUPNVSIT("AET",DFN,VDATE,HLOC,ENTYPE)) Q:(ENTYPE="")!(DONE) D
|
|
... S DAS=0
|
|
... F S DAS=$O(^AUPNVSIT("AET",DFN,VDATE,HLOC,ENTYPE,DAS)) Q:(DAS="")!(DONE) D
|
|
.... D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
|
|
.... S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
|
|
.... S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
|
|
.... I SAVE D
|
|
..... S NFOUND=NFOUND+1
|
|
..... S FIEVAL(NFOUND)=CONVAL
|
|
..... I COND'="" S FIEVAL(NFOUND,"CONDITION")=CONVAL
|
|
..... S FIEVAL(NFOUND,"DAS")=DAS
|
|
..... S FIEVAL(NFOUND,"DATE")=VDATE
|
|
..... M FIEVAL(NFOUND)=FIEVD
|
|
..... I $G(PXRMDEBG) M FIEVAL(NFOUND,"CSUB")=FIEVD
|
|
..... I NFOUND=NOCC S DONE=1
|
|
;Save the finding result.
|
|
D SFRES^PXRMUTIL(SDIR,NFOUND,.FIEVAL)
|
|
S FIEVAL("FILE NUMBER")=FILENUM
|
|
Q
|
|
;
|
|
;=================================================
|
|
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate location findings.
|
|
N BDT,EDT,FIEVT,FILENUM,FINDING,FINDPA,ITEM
|
|
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
|
|
S ITEM=""
|
|
F S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:+ITEM=0 D
|
|
. S FINDING=""
|
|
. F S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0 D
|
|
.. K FINDPA
|
|
.. M FINDPA=DEFARR(20,FINDING)
|
|
.. K FIEVT
|
|
.. D FIEVAL(FILENUM,"PI",DFN,ITEM,.FINDPA,.FIEVT)
|
|
.. M FIEVAL(FINDING)=FIEVT
|
|
.. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
|
|
Q
|
|
;
|
|
;=================================================
|
|
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate location terms.
|
|
N FIEVT,FILENUM,ITEM,PFINDPA
|
|
N TEMP,TFINDING,TFINDPA
|
|
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
|
|
S ITEM=""
|
|
F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
|
|
. S TFINDING=""
|
|
. F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
|
|
.. K FIEVT,PFINDPA,TFINDPA
|
|
.. M TFINDPA=TERMARR(20,TFINDING)
|
|
..;Set the finding parameters.
|
|
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
|
|
.. D FIEVAL(FILENUM,"PI",DFN,ITEM,.PFINDPA,.FIEVT)
|
|
.. M TFIEVAL(TFINDING)=FIEVT
|
|
.. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
|
|
Q
|
|
;
|
|
;=================================================
|
|
FIEVAL(FILENUM,SNODE,DFN,ITEM,PFINDPA,FIEVAL) ;
|
|
;Evaluate regular patient findings.
|
|
N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,FIEVD,FLIST,HLOC
|
|
N ICOND,IND,LNAME,NFOUND,NGET,NOCC,NP
|
|
N SAVE,SDIR,STATUSA,TEMP,UCIFS,VSLIST
|
|
S LNAME=$P(^PXRMD(810.9,ITEM,0),U,1)
|
|
I LNAME="VA-ALL LOCATIONS" D ALL(FILENUM,DFN,.PFINDPA,.FIEVAL) Q
|
|
;Set the finding search parameters.
|
|
D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
|
|
S SDIR=$S(NOCC<0:+1,1:-1)
|
|
S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
|
|
D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
|
|
S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC)
|
|
;Get a list of unique locations.
|
|
D LOCLIST(ITEM,"HLOCL")
|
|
D FPDAT(DFN,"HLOCL",NGET,BDT,EDT,.NFOUND,.FLIST)
|
|
I NFOUND=0 S FIEVAL=0 Q
|
|
S NP=0
|
|
F IND=1:1:NFOUND Q:NP=NOCC D
|
|
. S DAS=$P(FLIST(IND),U,1)
|
|
. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
|
|
. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
|
|
. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
|
|
. I SAVE D
|
|
.. S NP=NP+1
|
|
.. S FIEVAL(NP)=CONVAL
|
|
.. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
|
|
.. S FIEVAL(NP,"DAS")=$P(FLIST(IND),U,1)
|
|
.. S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2)
|
|
.. M FIEVAL(NP)=FIEVD
|
|
.. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVD
|
|
;
|
|
;Save the finding result.
|
|
D SFRES^PXRMUTIL(NOCC,NP,.FIEVAL)
|
|
S FIEVAL("FILE NUMBER")=FILENUM
|
|
Q
|
|
;
|
|
;=================================================
|
|
FPDAT(DFN,HLOCL,NOCC,BDT,EDT,NFOUND,FLIST) ;Find patient data for
|
|
;visits at a specified hospital location. Return up to NOCC most
|
|
;recent entries in FLIST where FLIST(1) is the most recent.
|
|
N DAS,DATE,DLIST,ENTYPE,HLOC,NF
|
|
S NFOUND=0
|
|
S DATE=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
|
|
;DBIA 2028
|
|
F S DATE=+$O(^AUPNVSIT("AET",DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)!(NFOUND=NOCC) D
|
|
. S HLOC=""
|
|
. F S HLOC=$O(^TMP($J,HLOCL,HLOC)) Q:(HLOC="")!(NFOUND=NOCC) D
|
|
.. I '$D(^AUPNVSIT("AET",DFN,DATE,HLOC)) Q
|
|
.. S NF=0
|
|
.. S ENTYPE=""
|
|
.. F S ENTYPE=$O(^AUPNVSIT("AET",DFN,DATE,HLOC,ENTYPE)) Q:(ENTYPE="")!(NFOUND=NOCC) D
|
|
... S DAS=0
|
|
... F S DAS=$O(^AUPNVSIT("AET",DFN,DATE,HLOC,ENTYPE,DAS)) Q:(DAS="")!(NFOUND=NOCC) D
|
|
....;Check the associated appointment for a valid status.
|
|
.... I '$$VAPSTAT^PXRMVSIT(DAS) Q
|
|
.... S NF=NF+1,NFOUND=NFOUND+1
|
|
.... S DLIST(DATE,NF)=DAS
|
|
S NFOUND=0
|
|
S DATE=""
|
|
F S DATE=$O(DLIST(DATE),-1) Q:DATE="" D
|
|
. S NF=0
|
|
. F S NF=$O(DLIST(DATE,NF)) Q:NF="" D
|
|
.. S NFOUND=NFOUND+1
|
|
.. S FLIST(NFOUND)=DLIST(DATE,NF)_U_DATE
|
|
K ^TMP($J,"HLOCL")
|
|
Q
|
|
;
|
|
;=================================================
|
|
LOCLIST(ITEM,SUB) ;Build a list of unique locations based on stop code
|
|
;and/or hospital location. Reads of ^SC covered by DBIA #4482.
|
|
N CS,EXCL,IND,JND,HLOC,SC
|
|
K ^TMP($J,SUB)
|
|
;Process stop codes. EXCL is the list of credit stops to exclude.
|
|
S IND=0
|
|
F S IND=+$O(^PXRMD(810.9,ITEM,40.7,IND)) Q:IND=0 D
|
|
. S SC=$P(^PXRMD(810.9,ITEM,40.7,IND,0),U,1)
|
|
. K EXCL
|
|
. S JND=0
|
|
. F S JND=+$O(^PXRMD(810.9,ITEM,40.7,IND,1,JND)) Q:JND=0 D
|
|
.. S EXCL=^PXRMD(810.9,ITEM,40.7,IND,1,JND,0)
|
|
.. S EXCL(EXCL)=""
|
|
. S HLOC=""
|
|
. F S HLOC=$O(^SC("AST",SC,HLOC)) Q:HLOC="" D
|
|
.. ;See if there are any to exclude.
|
|
.. S CS=$P(^SC(HLOC,0),U,18)
|
|
.. I CS'="",$D(EXCL(CS)) Q
|
|
.. S ^TMP($J,SUB,HLOC)=""
|
|
;Process locations.
|
|
S IND=0
|
|
F S IND=+$O(^PXRMD(810.9,ITEM,44,IND)) Q:IND=0 D
|
|
. S HLOC=^PXRMD(810.9,ITEM,44,IND,0)
|
|
. S ^TMP($J,SUB,HLOC)=""
|
|
Q
|
|
;
|
|
;=================================================
|
|
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
|
|
;DBIAs (^DIC(4: #10090), (^DIC(40.7: #557), (^SC: #10040)
|
|
N HLOC,IND,JND,LOC,NAME,NIN,NOUT,SC,TEMP,TEXTIN,TEXTOUT,VDATE
|
|
S NAME="Outpatient Encounter = "
|
|
S IND=0
|
|
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
|
|
. S NIN=0
|
|
. S VDATE=IFIEVAL(IND,"DATE")
|
|
. S LOC=$G(IFIEVAL(IND,"LOC. OF ENCOUNTER"))
|
|
. S LOC=$S(LOC="":"?",1:$P($G(^DIC(4,LOC,0)),U,1))
|
|
. S SC=$G(IFIEVAL(IND,"DSS ID"))
|
|
. S SC=$S(SC="":"?",1:" "_$P($G(^DIC(40.7,SC,0)),U,1))
|
|
. S HLOC=$G(IFIEVAL(IND,"HOSPITAL LOCATION"))
|
|
. S HLOC=$S(HLOC="":"?",1:" "_$P($G(^SC(HLOC,0)),U,1))
|
|
. S TEMP=NAME_LOC_HLOC_SC_" ("_$$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,IFIEVAL,NLINES,TEXT) ;Produce the clinical
|
|
;maintenance output.
|
|
;DBIAs (^DIC(4: #10090), (^DIC(40.7: #557), (^SC: #10040)
|
|
N EM,HLOC,IND,JND,LOC,NIN,NOUT,SC,STATUS,TEMP,TEXTIN,TEXTOUT,VDATE
|
|
S NLINES=NLINES+1
|
|
S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"PCE Encounter:"
|
|
S IND=0
|
|
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
|
|
. S NIN=0
|
|
. S VDATE=IFIEVAL(IND,"DATE")
|
|
. S TEMP=$$EDATE^PXRMDATE(VDATE)
|
|
. S LOC=$G(IFIEVAL(IND,"LOC. OF ENCOUNTER"))
|
|
. S LOC=$S(LOC="":"?",1:$P($G(^DIC(4,LOC,0)),U,1))
|
|
. S TEMP=TEMP_" Facility - "_LOC
|
|
. D FORMATS^PXRMTEXT(INDENT+1,PXRMRM,TEMP,.NOUT,.TEXTOUT)
|
|
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
|
|
. S HLOC=$G(IFIEVAL(IND,"HLOC"))
|
|
. I HLOC="" S HLOC="?"
|
|
. S TEMP="Hospital Location: "_HLOC
|
|
. S SC=$G(IFIEVAL(IND,"STOP CODE"))
|
|
. I SC="" S SC="?"
|
|
. S TEMP=TEMP_"; Clinic Stop: "_SC
|
|
. S NIN=NIN+1,TEXTIN(NIN)=TEMP_"\\"
|
|
. S SC=$G(IFIEVAL(IND,"SERVICE CATEGORY"))
|
|
. S TEMP="Service Category: "_SC_"="_$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
|
|
. S NIN=NIN+1,TEXTIN(NIN)=TEMP_"\\"
|
|
. S STATUS=$P($G(IFIEVAL(IND,"STATUS")),U,2)
|
|
. I STATUS="" S STATUS="?"
|
|
. S TEMP="Appointment Status: "_STATUS
|
|
. S NIN=NIN+1,TEXTIN(NIN)=TEMP_"\\"
|
|
. D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,NIN,.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
|
|
;
|