Index: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLOCF.m
===================================================================
--- FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLOCF.m	(revision 631)
+++ FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLOCF.m	(revision 636)
@@ -1,48 +1,43 @@
-PXRMLOCF ; SLC/PKR - Handle location findings. ;10/11/2007
- ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+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,BTIME,CASESEN,COND,CONVAL,DAS,DATE,DEND,DONE,DS,EDT,FIEVD
- N ICOND,INVBD,INVDATE,INVDT,INVED,NFOUND,NOCC
- N SAVE,SDIR,TEMP,TIME,UCIFS
+ 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 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
- S DEND=$S(EDT[".":EDT,1:EDT+.235959)
- S INVBD=9999999-$P(BDT,".",1),BTIME="."_$P(BDT,".",2)
- S INVED=9999999-$P(DEND,".",1),ETIME="."_$P(DEND,".",2)
- I SDIR=1 S DS=INVED-.000001
- I SDIR=-1 S DS=INVBD+.000001
- S INVDT=DS,(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 INVDT=$O(^AUPNVSIT("AA",DFN,INVDT),SDIR) Q:(DONE)!(INVDT="")  D
- . S INVDATE=$P(INVDT,".",1)
- . I (SDIR=1),INVDATE>INVBD S DONE=1 Q
- . I (SDIR=-1),INVDATE<INVED S DONE=1 Q
- . S TIME="."_$P(INVDT,".",2)
- . I INVDATE=INVED,TIME>ETIME Q
- . I INVDATE=INVBD,TIME<BTIME Q
- . S DAS=0
- . F  S DAS=$O(^AUPNVSIT("AA",DFN,INVDT,DAS)) Q:(DAS="")!(DONE)  D
- .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
- .. S CONVAL=$S(COND="":1,1:$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD))
- .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
- .. I SAVE D
- ... S TEMP=^AUPNVSIT(DAS,0)
- ... S NFOUND=NFOUND+1
- ... S FIEVAL(NFOUND)=CONVAL
- ... I COND'="" S FIEVAL(NFOUND,"CONDITION")=CONVAL
- ... S FIEVAL(NFOUND,"DAS")=DAS
- ... S FIEVAL(NFOUND,"DATE")=$P(TEMP,U,1)
- ... M FIEVAL(NFOUND)=FIEVD
- ... I $G(PXRMDEBG) M FIEVAL(NFOUND,"CSUB")=FIEVD
- ... I NFOUND=NOCC S DONE=1
+ 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)
+ D SFRES^PXRMUTIL(SDIR,NFOUND,.FIEVAL)
  S FIEVAL("FILE NUMBER")=FILENUM
  Q
@@ -92,11 +87,11 @@
  ;Set the finding search parameters.
  D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
- S SDIR=$S(NOCC<0:-1,1:1)
+ 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 NOCC=$S(NOCC<0:-NOCC,1:NOCC)
- S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
+ S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC)
  ;Get a list of unique locations.
  D LOCLIST(ITEM,"HLOCL")
- D FPDAT(DFN,"HLOCL",NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
+ D FPDAT(DFN,"HLOCL",NGET,BDT,EDT,.NFOUND,.FLIST)
  I NFOUND=0 S FIEVAL=0 Q
  S NP=0
@@ -121,45 +116,31 @@
  ;
  ;=================================================
-FPDAT(DFN,HLOCL,NOCC,SDIR,BDT,EDT,NFOUND,FLIST) ;Find patient data for
+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.
- ;"AA" in Visit file is inverse date_.time instead of a full inverse
- ;date and time. For example if the date/time is 3030704.104449 then
- ;"AA" has 6969295.104449 instead of 6969295.89555
- N BTIME,DAS,DATE,DEND,DLIST,DONE,DS,ETIME,HLOC
- N INVBD,INVDATE,INVDT,INVED,NF,TEMP,TIME
- S DEND=$S(EDT[".":EDT,1:EDT+.235959)
- S INVBD=9999999-$P(BDT,".",1),BTIME="."_$P(BDT,".",2)
- S INVED=9999999-$P(DEND,".",1),ETIME="."_$P(DEND,".",2)
- I SDIR=1 S DS=INVED-.000001
- I SDIR=-1 S DS=INVBD+.000001
- ;DBIA #2028
- S INVDT=DS,(DONE,NFOUND)=0
- F  S INVDT=$O(^AUPNVSIT("AA",DFN,INVDT),SDIR) Q:(INVDT="")!(DONE)  D
+ 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
- . S INVDATE=$P(INVDT,".",1)
- . I (SDIR=1),INVDATE>INVBD S DONE=1 Q
- . I (SDIR=-1),INVDATE<INVED S DONE=1 Q
- . S TIME="."_$P(INVDT,".",2)
- . I INVDATE=INVED,TIME>ETIME Q
- . I INVDATE=INVBD,TIME<BTIME Q
- . S DAS=0
- . F  S DAS=$O(^AUPNVSIT("AA",DFN,INVDT,DAS)) Q:(DAS="")!(DONE)  D
- .. S TEMP=^AUPNVSIT(DAS,0)
- .. S HLOC=$P(TEMP,U,22)
- .. I HLOC="" Q
- .. I '$D(^TMP($J,HLOCL,HLOC)) Q
- ..;Check the associated appointment for a valid status.
- .. I '$$VAPSTAT^PXRMVSIT(DAS) Q
- .. S DATE=$P(TEMP,U,1)
- .. S NF=NF+1,NFOUND=NFOUND+1
- .. I NFOUND=NOCC S DONE=1
- .. S DLIST(INVDT,NF)=DAS_U_DATE
- S INVDT="",NFOUND=0
- F  S INVDT=$O(DLIST(INVDT)) Q:INVDT=""  D
- . S NF=0
- . F  S NF=$O(DLIST(INVDT,NF)) Q:NF=""  D
+ . F  S NF=$O(DLIST(DATE,NF)) Q:NF=""  D
  .. S NFOUND=NFOUND+1
- .. S FLIST(NFOUND)=DLIST(INVDT,NF)
+ .. S FLIST(NFOUND)=DLIST(DATE,NF)_U_DATE
  K ^TMP($J,"HLOCL")
  Q
