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