[628] | 1 | PXRMLOCF ; SLC/PKR - Handle location findings. ;10/11/2007
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
|
---|
| 3 | ;This routine is for location list patient findings.
|
---|
| 4 | ;=================================================
|
---|
| 5 | ALL(FILENUM,DFN,PFINDPA,FIEVAL) ;Get all Visits with a location
|
---|
| 6 | ;for a patient.
|
---|
| 7 | N BDT,BTIME,CASESEN,COND,CONVAL,DAS,DATE,DEND,DONE,DS,EDT,FIEVD
|
---|
| 8 | N ICOND,INVBD,INVDATE,INVDT,INVED,NFOUND,NOCC
|
---|
| 9 | N SAVE,SDIR,TEMP,TIME,UCIFS
|
---|
| 10 | ;Set the finding search parameters.
|
---|
| 11 | D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
|
---|
| 12 | S SDIR=$S(NOCC<0:-1,1:1)
|
---|
| 13 | S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
|
---|
| 14 | D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
|
---|
| 15 | S (DONE,NFOUND)=0
|
---|
| 16 | S DEND=$S(EDT[".":EDT,1:EDT+.235959)
|
---|
| 17 | S INVBD=9999999-$P(BDT,".",1),BTIME="."_$P(BDT,".",2)
|
---|
| 18 | S INVED=9999999-$P(DEND,".",1),ETIME="."_$P(DEND,".",2)
|
---|
| 19 | I SDIR=1 S DS=INVED-.000001
|
---|
| 20 | I SDIR=-1 S DS=INVBD+.000001
|
---|
| 21 | S INVDT=DS,(DONE,NFOUND)=0
|
---|
| 22 | ;DBIA 2028
|
---|
| 23 | F S INVDT=$O(^AUPNVSIT("AA",DFN,INVDT),SDIR) Q:(DONE)!(INVDT="") D
|
---|
| 24 | . S INVDATE=$P(INVDT,".",1)
|
---|
| 25 | . I (SDIR=1),INVDATE>INVBD S DONE=1 Q
|
---|
| 26 | . I (SDIR=-1),INVDATE<INVED S DONE=1 Q
|
---|
| 27 | . S TIME="."_$P(INVDT,".",2)
|
---|
| 28 | . I INVDATE=INVED,TIME>ETIME Q
|
---|
| 29 | . I INVDATE=INVBD,TIME<BTIME Q
|
---|
| 30 | . S DAS=0
|
---|
| 31 | . F S DAS=$O(^AUPNVSIT("AA",DFN,INVDT,DAS)) Q:(DAS="")!(DONE) D
|
---|
| 32 | .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
|
---|
| 33 | .. S CONVAL=$S(COND="":1,1:$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD))
|
---|
| 34 | .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
|
---|
| 35 | .. I SAVE D
|
---|
| 36 | ... S TEMP=^AUPNVSIT(DAS,0)
|
---|
| 37 | ... S NFOUND=NFOUND+1
|
---|
| 38 | ... S FIEVAL(NFOUND)=CONVAL
|
---|
| 39 | ... I COND'="" S FIEVAL(NFOUND,"CONDITION")=CONVAL
|
---|
| 40 | ... S FIEVAL(NFOUND,"DAS")=DAS
|
---|
| 41 | ... S FIEVAL(NFOUND,"DATE")=$P(TEMP,U,1)
|
---|
| 42 | ... M FIEVAL(NFOUND)=FIEVD
|
---|
| 43 | ... I $G(PXRMDEBG) M FIEVAL(NFOUND,"CSUB")=FIEVD
|
---|
| 44 | ... I NFOUND=NOCC S DONE=1
|
---|
| 45 | ;Save the finding result.
|
---|
| 46 | D SFRES^PXRMUTIL(-SDIR,NFOUND,.FIEVAL)
|
---|
| 47 | S FIEVAL("FILE NUMBER")=FILENUM
|
---|
| 48 | Q
|
---|
| 49 | ;
|
---|
| 50 | ;=================================================
|
---|
| 51 | EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate location findings.
|
---|
| 52 | N BDT,EDT,FIEVT,FILENUM,FINDING,FINDPA,ITEM
|
---|
| 53 | S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
|
---|
| 54 | S ITEM=""
|
---|
| 55 | F S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:+ITEM=0 D
|
---|
| 56 | . S FINDING=""
|
---|
| 57 | . F S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0 D
|
---|
| 58 | .. K FINDPA
|
---|
| 59 | .. M FINDPA=DEFARR(20,FINDING)
|
---|
| 60 | .. K FIEVT
|
---|
| 61 | .. D FIEVAL(FILENUM,"PI",DFN,ITEM,.FINDPA,.FIEVT)
|
---|
| 62 | .. M FIEVAL(FINDING)=FIEVT
|
---|
| 63 | .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
|
---|
| 64 | Q
|
---|
| 65 | ;
|
---|
| 66 | ;=================================================
|
---|
| 67 | EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate location terms.
|
---|
| 68 | N FIEVT,FILENUM,ITEM,PFINDPA
|
---|
| 69 | N TEMP,TFINDING,TFINDPA
|
---|
| 70 | S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
|
---|
| 71 | S ITEM=""
|
---|
| 72 | F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
|
---|
| 73 | . S TFINDING=""
|
---|
| 74 | . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
|
---|
| 75 | .. K FIEVT,PFINDPA,TFINDPA
|
---|
| 76 | .. M TFINDPA=TERMARR(20,TFINDING)
|
---|
| 77 | ..;Set the finding parameters.
|
---|
| 78 | .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
|
---|
| 79 | .. D FIEVAL(FILENUM,"PI",DFN,ITEM,.PFINDPA,.FIEVT)
|
---|
| 80 | .. M TFIEVAL(TFINDING)=FIEVT
|
---|
| 81 | .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
|
---|
| 82 | Q
|
---|
| 83 | ;
|
---|
| 84 | ;=================================================
|
---|
| 85 | FIEVAL(FILENUM,SNODE,DFN,ITEM,PFINDPA,FIEVAL) ;
|
---|
| 86 | ;Evaluate regular patient findings.
|
---|
| 87 | N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,FIEVD,FLIST,HLOC
|
---|
| 88 | N ICOND,IND,LNAME,NFOUND,NGET,NOCC,NP
|
---|
| 89 | N SAVE,SDIR,STATUSA,TEMP,UCIFS,VSLIST
|
---|
| 90 | S LNAME=$P(^PXRMD(810.9,ITEM,0),U,1)
|
---|
| 91 | I LNAME="VA-ALL LOCATIONS" D ALL(FILENUM,DFN,.PFINDPA,.FIEVAL) Q
|
---|
| 92 | ;Set the finding search parameters.
|
---|
| 93 | D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
|
---|
| 94 | S SDIR=$S(NOCC<0:-1,1:1)
|
---|
| 95 | D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
|
---|
| 96 | S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
|
---|
| 97 | S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
|
---|
| 98 | ;Get a list of unique locations.
|
---|
| 99 | D LOCLIST(ITEM,"HLOCL")
|
---|
| 100 | D FPDAT(DFN,"HLOCL",NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
|
---|
| 101 | I NFOUND=0 S FIEVAL=0 Q
|
---|
| 102 | S NP=0
|
---|
| 103 | F IND=1:1:NFOUND Q:NP=NOCC D
|
---|
| 104 | . S DAS=$P(FLIST(IND),U,1)
|
---|
| 105 | . D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
|
---|
| 106 | . S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
|
---|
| 107 | . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
|
---|
| 108 | . I SAVE D
|
---|
| 109 | .. S NP=NP+1
|
---|
| 110 | .. S FIEVAL(NP)=CONVAL
|
---|
| 111 | .. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
|
---|
| 112 | .. S FIEVAL(NP,"DAS")=$P(FLIST(IND),U,1)
|
---|
| 113 | .. S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2)
|
---|
| 114 | .. M FIEVAL(NP)=FIEVD
|
---|
| 115 | .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVD
|
---|
| 116 | ;
|
---|
| 117 | ;Save the finding result.
|
---|
| 118 | D SFRES^PXRMUTIL(NOCC,NP,.FIEVAL)
|
---|
| 119 | S FIEVAL("FILE NUMBER")=FILENUM
|
---|
| 120 | Q
|
---|
| 121 | ;
|
---|
| 122 | ;=================================================
|
---|
| 123 | FPDAT(DFN,HLOCL,NOCC,SDIR,BDT,EDT,NFOUND,FLIST) ;Find patient data for
|
---|
| 124 | ;visits at a specified hospital location. Return up to NOCC most
|
---|
| 125 | ;recent entries in FLIST where FLIST(1) is the most recent.
|
---|
| 126 | ;"AA" in Visit file is inverse date_.time instead of a full inverse
|
---|
| 127 | ;date and time. For example if the date/time is 3030704.104449 then
|
---|
| 128 | ;"AA" has 6969295.104449 instead of 6969295.89555
|
---|
| 129 | N BTIME,DAS,DATE,DEND,DLIST,DONE,DS,ETIME,HLOC
|
---|
| 130 | N INVBD,INVDATE,INVDT,INVED,NF,TEMP,TIME
|
---|
| 131 | S DEND=$S(EDT[".":EDT,1:EDT+.235959)
|
---|
| 132 | S INVBD=9999999-$P(BDT,".",1),BTIME="."_$P(BDT,".",2)
|
---|
| 133 | S INVED=9999999-$P(DEND,".",1),ETIME="."_$P(DEND,".",2)
|
---|
| 134 | I SDIR=1 S DS=INVED-.000001
|
---|
| 135 | I SDIR=-1 S DS=INVBD+.000001
|
---|
| 136 | ;DBIA #2028
|
---|
| 137 | S INVDT=DS,(DONE,NFOUND)=0
|
---|
| 138 | F S INVDT=$O(^AUPNVSIT("AA",DFN,INVDT),SDIR) Q:(INVDT="")!(DONE) D
|
---|
| 139 | . S NF=0
|
---|
| 140 | . S INVDATE=$P(INVDT,".",1)
|
---|
| 141 | . I (SDIR=1),INVDATE>INVBD S DONE=1 Q
|
---|
| 142 | . I (SDIR=-1),INVDATE<INVED S DONE=1 Q
|
---|
| 143 | . S TIME="."_$P(INVDT,".",2)
|
---|
| 144 | . I INVDATE=INVED,TIME>ETIME Q
|
---|
| 145 | . I INVDATE=INVBD,TIME<BTIME Q
|
---|
| 146 | . S DAS=0
|
---|
| 147 | . F S DAS=$O(^AUPNVSIT("AA",DFN,INVDT,DAS)) Q:(DAS="")!(DONE) D
|
---|
| 148 | .. S TEMP=^AUPNVSIT(DAS,0)
|
---|
| 149 | .. S HLOC=$P(TEMP,U,22)
|
---|
| 150 | .. I HLOC="" Q
|
---|
| 151 | .. I '$D(^TMP($J,HLOCL,HLOC)) Q
|
---|
| 152 | ..;Check the associated appointment for a valid status.
|
---|
| 153 | .. I '$$VAPSTAT^PXRMVSIT(DAS) Q
|
---|
| 154 | .. S DATE=$P(TEMP,U,1)
|
---|
| 155 | .. S NF=NF+1,NFOUND=NFOUND+1
|
---|
| 156 | .. I NFOUND=NOCC S DONE=1
|
---|
| 157 | .. S DLIST(INVDT,NF)=DAS_U_DATE
|
---|
| 158 | S INVDT="",NFOUND=0
|
---|
| 159 | F S INVDT=$O(DLIST(INVDT)) Q:INVDT="" D
|
---|
| 160 | . S NF=0
|
---|
| 161 | . F S NF=$O(DLIST(INVDT,NF)) Q:NF="" D
|
---|
| 162 | .. S NFOUND=NFOUND+1
|
---|
| 163 | .. S FLIST(NFOUND)=DLIST(INVDT,NF)
|
---|
| 164 | K ^TMP($J,"HLOCL")
|
---|
| 165 | Q
|
---|
| 166 | ;
|
---|
| 167 | ;=================================================
|
---|
| 168 | LOCLIST(ITEM,SUB) ;Build a list of unique locations based on stop code
|
---|
| 169 | ;and/or hospital location. Reads of ^SC covered by DBIA #4482.
|
---|
| 170 | N CS,EXCL,IND,JND,HLOC,SC
|
---|
| 171 | K ^TMP($J,SUB)
|
---|
| 172 | ;Process stop codes. EXCL is the list of credit stops to exclude.
|
---|
| 173 | S IND=0
|
---|
| 174 | F S IND=+$O(^PXRMD(810.9,ITEM,40.7,IND)) Q:IND=0 D
|
---|
| 175 | . S SC=$P(^PXRMD(810.9,ITEM,40.7,IND,0),U,1)
|
---|
| 176 | . K EXCL
|
---|
| 177 | . S JND=0
|
---|
| 178 | . F S JND=+$O(^PXRMD(810.9,ITEM,40.7,IND,1,JND)) Q:JND=0 D
|
---|
| 179 | .. S EXCL=^PXRMD(810.9,ITEM,40.7,IND,1,JND,0)
|
---|
| 180 | .. S EXCL(EXCL)=""
|
---|
| 181 | . S HLOC=""
|
---|
| 182 | . F S HLOC=$O(^SC("AST",SC,HLOC)) Q:HLOC="" D
|
---|
| 183 | .. ;See if there are any to exclude.
|
---|
| 184 | .. S CS=$P(^SC(HLOC,0),U,18)
|
---|
| 185 | .. I CS'="",$D(EXCL(CS)) Q
|
---|
| 186 | .. S ^TMP($J,SUB,HLOC)=""
|
---|
| 187 | ;Process locations.
|
---|
| 188 | S IND=0
|
---|
| 189 | F S IND=+$O(^PXRMD(810.9,ITEM,44,IND)) Q:IND=0 D
|
---|
| 190 | . S HLOC=^PXRMD(810.9,ITEM,44,IND,0)
|
---|
| 191 | . S ^TMP($J,SUB,HLOC)=""
|
---|
| 192 | Q
|
---|
| 193 | ;
|
---|
| 194 | ;=================================================
|
---|
| 195 | MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
|
---|
| 196 | ;DBIAs (^DIC(4: #10090), (^DIC(40.7: #557), (^SC: #10040)
|
---|
| 197 | N HLOC,IND,JND,LOC,NAME,NIN,NOUT,SC,TEMP,TEXTIN,TEXTOUT,VDATE
|
---|
| 198 | S NAME="Outpatient Encounter = "
|
---|
| 199 | S IND=0
|
---|
| 200 | F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
|
---|
| 201 | . S NIN=0
|
---|
| 202 | . S VDATE=IFIEVAL(IND,"DATE")
|
---|
| 203 | . S LOC=$G(IFIEVAL(IND,"LOC. OF ENCOUNTER"))
|
---|
| 204 | . S LOC=$S(LOC="":"?",1:$P($G(^DIC(4,LOC,0)),U,1))
|
---|
| 205 | . S SC=$G(IFIEVAL(IND,"DSS ID"))
|
---|
| 206 | . S SC=$S(SC="":"?",1:" "_$P($G(^DIC(40.7,SC,0)),U,1))
|
---|
| 207 | . S HLOC=$G(IFIEVAL(IND,"HOSPITAL LOCATION"))
|
---|
| 208 | . S HLOC=$S(HLOC="":"?",1:" "_$P($G(^SC(HLOC,0)),U,1))
|
---|
| 209 | . S TEMP=NAME_LOC_HLOC_SC_" ("_$$EDATE^PXRMDATE(VDATE)_")"
|
---|
| 210 | . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
|
---|
| 211 | . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
|
---|
| 212 | S NLINES=NLINES+1,TEXT(NLINES)=""
|
---|
| 213 | Q
|
---|
| 214 | ;
|
---|
| 215 | ;=================================================
|
---|
| 216 | OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
|
---|
| 217 | ;maintenance output.
|
---|
| 218 | ;DBIAs (^DIC(4: #10090), (^DIC(40.7: #557), (^SC: #10040)
|
---|
| 219 | N EM,HLOC,IND,JND,LOC,NIN,NOUT,SC,STATUS,TEMP,TEXTIN,TEXTOUT,VDATE
|
---|
| 220 | S NLINES=NLINES+1
|
---|
| 221 | S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"PCE Encounter:"
|
---|
| 222 | S IND=0
|
---|
| 223 | F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
|
---|
| 224 | . S NIN=0
|
---|
| 225 | . S VDATE=IFIEVAL(IND,"DATE")
|
---|
| 226 | . S TEMP=$$EDATE^PXRMDATE(VDATE)
|
---|
| 227 | . S LOC=$G(IFIEVAL(IND,"LOC. OF ENCOUNTER"))
|
---|
| 228 | . S LOC=$S(LOC="":"?",1:$P($G(^DIC(4,LOC,0)),U,1))
|
---|
| 229 | . S TEMP=TEMP_" Facility - "_LOC
|
---|
| 230 | . D FORMATS^PXRMTEXT(INDENT+1,PXRMRM,TEMP,.NOUT,.TEXTOUT)
|
---|
| 231 | . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
|
---|
| 232 | . S HLOC=$G(IFIEVAL(IND,"HLOC"))
|
---|
| 233 | . I HLOC="" S HLOC="?"
|
---|
| 234 | . S TEMP="Hospital Location: "_HLOC
|
---|
| 235 | . S SC=$G(IFIEVAL(IND,"STOP CODE"))
|
---|
| 236 | . I SC="" S SC="?"
|
---|
| 237 | . S TEMP=TEMP_"; Clinic Stop: "_SC
|
---|
| 238 | . S NIN=NIN+1,TEXTIN(NIN)=TEMP_"\\"
|
---|
| 239 | . S SC=$G(IFIEVAL(IND,"SERVICE CATEGORY"))
|
---|
| 240 | . S TEMP="Service Category: "_SC_"="_$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
|
---|
| 241 | . S NIN=NIN+1,TEXTIN(NIN)=TEMP_"\\"
|
---|
| 242 | . S STATUS=$P($G(IFIEVAL(IND,"STATUS")),U,2)
|
---|
| 243 | . I STATUS="" S STATUS="?"
|
---|
| 244 | . S TEMP="Appointment Status: "_STATUS
|
---|
| 245 | . S NIN=NIN+1,TEXTIN(NIN)=TEMP_"\\"
|
---|
| 246 | . D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,NIN,.TEXTIN,.NOUT,.TEXTOUT)
|
---|
| 247 | . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
|
---|
| 248 | . I IFIEVAL(IND,"COMMENTS")'="" D
|
---|
| 249 | .. S TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
|
---|
| 250 | .. D FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
|
---|
| 251 | .. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
|
---|
| 252 | S NLINES=NLINES+1,TEXT(NLINES)=""
|
---|
| 253 | Q
|
---|
| 254 | ;
|
---|