Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLOCF.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLOCF.m
r628 r636 1 PXRMLOCF ; SLC/PKR - Handle location findings. ; 10/11/20072 ;;2.0;CLINICAL REMINDERS;**4 ,6**;Feb 04, 2005;Build 1231 PXRMLOCF ; SLC/PKR - Handle location findings. ;07/17/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 3 ;This routine is for location list patient findings. 4 4 ;================================================= 5 5 ALL(FILENUM,DFN,PFINDPA,FIEVAL) ;Get all Visits with a location 6 6 ;for a patient. 7 N BDT, BTIME,CASESEN,COND,CONVAL,DAS,DATE,DEND,DONE,DS,EDT,FIEVD8 N ICOND,IN VBD,INVDATE,INVDT,INVED,NFOUND,NOCC9 N SAVE,SDIR,TEMP, TIME,UCIFS7 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 10 ;Set the finding search parameters. 11 11 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT) 12 S SDIR=$S(NOCC<0: -1,1:1)12 S SDIR=$S(NOCC<0:+1,1:-1) 13 13 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 14 14 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST) 15 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 16 I SDIR=1 S VDATE=BDT-.0000001 17 I SDIR=-1 S VDATE=$S(EDT[".":EDT+.0000001,1:EDT+.240001) 22 18 ;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 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 45 40 ;Save the finding result. 46 D SFRES^PXRMUTIL( -SDIR,NFOUND,.FIEVAL)41 D SFRES^PXRMUTIL(SDIR,NFOUND,.FIEVAL) 47 42 S FIEVAL("FILE NUMBER")=FILENUM 48 43 Q … … 92 87 ;Set the finding search parameters. 93 88 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT) 94 S SDIR=$S(NOCC<0:-1,1:1) 89 S SDIR=$S(NOCC<0:+1,1:-1) 90 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 95 91 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) 92 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC) 98 93 ;Get a list of unique locations. 99 94 D LOCLIST(ITEM,"HLOCL") 100 D FPDAT(DFN,"HLOCL",NGET, SDIR,BDT,EDT,.NFOUND,.FLIST)95 D FPDAT(DFN,"HLOCL",NGET,BDT,EDT,.NFOUND,.FLIST) 101 96 I NFOUND=0 S FIEVAL=0 Q 102 97 S NP=0 … … 121 116 ; 122 117 ;================================================= 123 FPDAT(DFN,HLOCL,NOCC, SDIR,BDT,EDT,NFOUND,FLIST) ;Find patient data for118 FPDAT(DFN,HLOCL,NOCC,BDT,EDT,NFOUND,FLIST) ;Find patient data for 124 119 ;visits at a specified hospital location. Return up to NOCC most 125 120 ;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 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 139 141 . 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 142 . F S NF=$O(DLIST(DATE,NF)) Q:NF="" D 162 143 .. S NFOUND=NFOUND+1 163 .. S FLIST(NFOUND)=DLIST( INVDT,NF)144 .. S FLIST(NFOUND)=DLIST(DATE,NF)_U_DATE 164 145 K ^TMP($J,"HLOCL") 165 146 Q
Note:
See TracChangeset
for help on using the changeset viewer.