Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLOCL.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_REMINDERS-PXRM/PXRMLOCL.m (modified) (6 diffs)

FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLOCL.m

@@ -1 @@
-PXRMLOCL ; SLC/PKR - Handle location findings. ;07/26/2007
- ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+PXRMLOCL ; 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 lists.
  ;=============================================
@@ -33 +33 @@
  ;a visit to a hospital location. Return the list in ^TMP($J,PLIST).
  N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED
- N NFOUND,SC,TEMP,TGLIST,TIME
+ N NFOUND,TEMP,TGLIST,TIME
  S TGLIST="FPLIST_PXRMLOCL"
  K ^TMP($J,TGLIST)
- S DEND=$S(EDT[".":EDT,1:EDT+.235959)
+ S DEND=$S(EDT[".":EDT,1:EDT+.240001)
  ;"AHL" 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
  ;"AHL" has 6969295.104449 instead of 6969295.89555
- S INVBD=9999999-$P(BDT,".",1),BTIME="."_$P(BDT,".",2)
- S INVED=9999999-$P(DEND,".",1),ETIME="."_$P(DEND,".",2)
- S DS=INVED-.000001
+ S INVBD=9999999-$P(BDT,".",1),BTIME=+("."_$P(BDT,".",2))
+ S INVED=9999999-$P(DEND,".",1),ETIME=+("."_$P(DEND,".",2))
+ S DS=INVED-1
  S HLOC=""
  F  S HLOC=$O(^TMP($J,HLOCL,HLOC)) Q:HLOC=""  D
@@ -50 +50 @@
  .. S INVDATE=$P(INVDT,".",1)
  .. I INVDATE>INVBD S DONE=1 Q
- .. S TIME="."_$P(INVDT,".",2)
+ .. S TIME=+("."_$P(INVDT,".",2))
  .. I INVDATE=INVED,TIME>ETIME Q
- .. I INVDATE=INVBD,TIME<BTIME Q
+ .. I INVDATE=INVBD,BTIME>TIME S DONE=1 Q
  .. S DAS=0
  .. F  S DAS=$O(^AUPNVSIT("AHL",HLOC,INVDT,DAS)) Q:DAS=""  D
@@ -58 +58 @@
  ... I '$$VAPSTAT^PXRMVSIT(DAS) Q
  ... S TEMP=^AUPNVSIT(DAS,0)
+ ... S DFN=$P(TEMP,U,5)
  ... S DATE=$P(TEMP,U,1)
- ... S DFN=$P(TEMP,U,5)
- ... S SC=$P(TEMP,U,7)
- ... S ^TMP($J,TGLIST,DFN,INVDT,DAS)=DATE_U_HLOC_U_SC
+ ... S ^TMP($J,TGLIST,DFN,INVDT,DAS)=DATE_U_HLOC
  ;Return the NOCC most recent for each patient.
  S DFN=0
@@ -75 +74 @@
  ;
  ;=============================================
-FTEST(FILENUM,HLOCL,NOCC,BDT,EDT,PLIST) ;Find patient list data for
- ;a visit to a hospital location. Return the list in ^TMP($J,PLIST).
- N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED
- N NFOUND,TEMP,TGLIST,TIME
- S TGLIST="FPLIST_PXRMLOCL"
- K ^TMP($J,TGLIST)
- S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
- S HLOC=""
- F  S HLOC=$O(^TMP($J,HLOCL,HLOC)) Q:HLOC=""  D
- . S DATE=DS
- . F  S DATE=+$O(^AUPNVSIT("AHDP",HLOC,DATE),-1) Q:(DATE=0)!(DATE<BDT)  D
- .. S DFN=""
- .. F  S DFN=$O(^AUPNVSIT("AHDP",HLOC,DATE,DFN)) Q:DFN=""  D
- ... S SC=""
- ... F  S SC=$O(^AUPNVSIT("AHDP",HLOC,DATE,DFN,SC)) Q:SC=""  D
- .... S DAS=$O(^AUPNVSIT("AHDP",HLOC,DATE,DFN,SC,""))
- .... I '$$VAPSTAT^PXRMVSIT(DAS) Q
- .... S ^TMP($J,TGLIST,DFN,DATE,DAS)=HLOC
- ;Return the NOCC most recent for each patient.
- S DFN=0
- F  S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN=""  D
- . S DATE="",NFOUND=0
- . F  S DATE=$O(^TMP($J,TGLIST,DFN,DATE),-1) Q:(NFOUND=NOCC)!(DATE="")  D
- .. S DAS=""
- .. F  S DAS=$O(^TMP($J,TGLIST,DFN,DATE,DAS)) Q:(NFOUND=NOCC)!(DAS="")  D
- ... S NFOUND=NFOUND+1
- ... S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_DATE_U_^TMP($J,TGLIST,DFN,DATE,DAS)
- K ^TMP($J,TGLIST)
- Q
- ;
- ;=============================================
 GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list.
  ; Return the list in ^TMP($J,PLIST).
@@ -115 +83 @@
  ;Set the finding search parameters.
  D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
- ;Ignore negative occurrence count, date reversal not allowed in
- ;patient lists.
  S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
  D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
- S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
+ S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC)
  ;Get a list of unique locations.
  S LNAME=$P(^PXRMD(810.9,ITEM,0),U,1)