Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRRFDSE

PXRRFDSE.m

Go to the documentation of this file. 
  1. PXRRFDSE ;ISL/PKR - Sort through encounters applying the selection criteria. ;3/11/98
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,31,49**;Aug 12, 1996
  1. SORT ;
  1.  N BD,BUSY,CLASSIEN,CLASSNAM,CLINIC,CLINIEN,CSSCR,DOB,DFN,ED
  1.  N IC,FAC,FACILITY,FOUND
  1.  N HLOC,HLOCIEN,HLOCNAM,HSSCR,NEWPIEN
  1.  N PATSCR,PCLASS,PNAME,PPONLY,PRVIEN,PRVALL,PRVSCR
  1.  N RACEUNK,TEMP,VIEN,VISIT
  1.  ;
  1.  ;Allow the task to be cleaned up upon successful completion.
  1.  S ZTREQ="@"
  1.  ;
  1.  I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
  1.  ;
  1.  ;CSSCR is true if we want selected clinics.
  1.  I $G(NCS)>0 S CSSCR=1
  1.  E  S CSSCR=0,CLINIC=0
  1.  ;
  1.  ;CLINIC is true if we want clinics instead of hospital locations.
  1.  I $P($G(PXRRLCSC),U,1)["C" S CLINIC=1
  1.  E  S CLINIC=0
  1.  ;
  1.  ;HSSCR is true if we want selected hospital locations.
  1.  I $P($G(PXRRLCSC),U,1)="HS" S HSSCR=1
  1.  E  S HSSCR=0
  1.  ;
  1.  ;HLOC is true if we want hospital locations.
  1.  I $P($G(PXRRLCSC),U,1)["H" S HLOC=1
  1.  E  S HLOC=0
  1.  ;
  1.  ;PATSCR is true if we have a patient screen.
  1.  S PATSCR=0
  1.  I $D(PXRRDOB) D
  1.  . S PATSCR=1
  1.  .;If the starting or ending date of birth is not defined at this point
  1.  .;then we should not screen for them.  So set them to values that will
  1.  .;always be true.  Remember the test is DOBS <= DOB <= DOBE so that
  1.  .;DOBS corresponds to the maximum age and DOBE to the minimum age.
  1.  . I '$D(PXRRDOBS) S PXRRDOBS=0
  1.  . I '$D(PXRRDOBE) S PXRRDOBE=DT
  1.  I $D(PXRRRACE) D
  1.  . S PATSCR=1
  1.  .;Find the "UNKNOWN" race entry.
  1.  . N TRACE,TERR
  1.  . D FIND^DIC(10,"","","O","UNKNOWN",1,"B","","","TRACE","TERR")
  1.  . S RACEUNK=TRACE("DILIST",2,1)_U_TRACE("DILIST",1,1)
  1.  I $D(PXRRSEX) S PATSCR=1
  1.  ;
  1.  ;PRVSCR is true if we have a provider screen
  1.  I $D(PXRRPRSC) S PRVSCR=1
  1.  E  S CLASSNAM=0,PRVSCR=0,PNAME=1
  1.  ;
  1.  ;If they are asking for all providers then we don't really need to
  1.  ; screen.
  1.  ;I PRVSCR I $P(PXRRPRSC,U,1)="A" S CLASSNAM=0,PRVSCR=0,PNAME=1
  1.  ;See if all providers were requested.
  1.  I PRVSCR I $P(PXRRPRSC,U,1)="A" S PRVALL=1
  1.  E  S PRVALL=0
  1.  ;
  1.  ;PPONLY is true if we want primary providers only.
  1.  I PRVSCR I $P(PXRRPRSC,U,1)="P" S PPONLY=1
  1.  E  S PPONLY=0
  1.  ;
  1.  ;Allow the task to be cleaned up upon successful completion.
  1.  S ZTREQ="@"
  1.  ;
  1.  S BD=PXRRBDT-.0001
  1.  S ED=PXRREDT+.2359
  1. NDATE S BD=$O(^AUPNVSIT("B",BD))
  1.  ;If we have passed the ending date we are done.
  1.  I (BD>ED)!(BD="") G DONE
  1.  ;
  1.  ;Check for a user request to stop the task.
  1.  I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRFDD
  1.  ;
  1.  ;Get the VISIT IEN
  1.  S VIEN=0
  1. VISIT S VIEN=$O(^AUPNVSIT("B",BD,VIEN))
  1.  I VIEN="" G NDATE
  1.  S VISIT=^AUPNVSIT(VIEN,0)
  1.  ;
  1.  ;If this is an interactive session let the user know that something
  1.  ;is happening.
  1.  I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting encounters",.BUSY)
  1.  ;
  1.  ;Service category screen.
  1.  I $D(PXRRSCAT) I PXRRSCAT'[$P(VISIT,U,7) G VISIT
  1.  ;
  1.  ;Encounter type screen.
  1.  I $D(PXRRETYP) I PXRRETYP'[$P(VISIT,U,3) G VISIT
  1.  ;
  1.  ;Patient screen.  If we have a patient screen then we need to make a
  1.  ;VADPT call to get the patient information.
  1.  I PATSCR D
  1.  . S DFN=$P(VISIT,U,5)
  1.  . D KVAR^VADPT
  1.  . D DEM^VADPT
  1.  ;
  1.  S FOUND=1
  1.  ;
  1.  ;Patient DOB screen.
  1.  I $D(PXRRDOB) D
  1.  . S DOB=$P(VADM(3),U,1)
  1.  . I (DOB<PXRRDOBS)!(DOB>PXRRDOBE) S FOUND=0
  1.  I 'FOUND G VISIT
  1.  ;
  1.  ;Patient RACE screen.
  1.  I $D(PXRRRACE) D
  1.  . S FOUND=0
  1.  . I VADM(8)="" S VADM(8)=RACEUNK
  1.  . F IC=1:1:NRACE Q:FOUND  D
  1.  .. I PXRRRACE(IC)=VADM(8) S FOUND=1
  1.  I 'FOUND G VISIT
  1.  ;
  1.  ;Patient SEX screen.
  1.  I $D(PXRRSEX) D
  1.  . I PXRRSEX'=VADM(5) S FOUND=0
  1.  I 'FOUND G VISIT
  1.  ;
  1.  ;Make sure that the facility is on the list.
  1.  S FOUND=0
  1.  S FAC=$P(VISIT,U,6)
  1.  F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FAC D  Q
  1.  . S FACILITY=FAC
  1.  . S FOUND=1
  1.  I 'FOUND G VISIT
  1.  ;
  1.  ;Provider screen.
  1.  S PRVIEN=0
  1. PRV ;To allow for encounters without a provider the check for a null PRVIEN
  1.  ;is made after everything else has been done.
  1.  I PRVIEN="" G VISIT
  1.  I PRVSCR D
  1.  . S PRVIEN=$O(^AUPNVPRV("AD",VIEN,PRVIEN))
  1.  . I $L(PRVIEN)>0 S NEWPIEN=$P(^AUPNVPRV(PRVIEN,0),U,1)
  1.  . E  S NEWPIEN=0
  1.  . S (CLASSNAM,PNAME)=1
  1.  S FOUND=1
  1.  ;
  1.  ;All providers by name.
  1.  I PRVALL D
  1.  . S PNAME=$P($G(^VA(200,NEWPIEN,0)),U,1)
  1.  . I $L(PNAME)=0 S PNAME=1
  1.  . E  S PNAME=PNAME_U_NEWPIEN
  1.  ;
  1.  ;List of providers.
  1.  I $D(PXRRPRPL) D
  1.  . S FOUND=0
  1.  . F IC=1:1:NPL I $P(PXRRPRPL(IC),U,2)=NEWPIEN D  Q
  1.  ..;Mark this provider as being found.
  1.  .. S $P(PXRRPRPL(IC),U,4)="M"
  1.  .. S PNAME=$P(PXRRPRPL(IC),U,1,2)
  1.  .. S FOUND=1
  1.  ;
  1.  ;If we are storing provider names, i.e., PNAME'=1, then store the Person
  1.  ;Class alpha abbreviation as the third piece of PNAME.
  1.  I PNAME'=1 D
  1.  . S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1)
  1.  . S TEMP=$$ALPHA^PXRRPECU(PCLASS)
  1.  . S PNAME=PNAME_U_TEMP
  1.  I 'FOUND G PRV
  1.  ;
  1.  ;Person class screen.
  1.  I $D(PXRRPECL) D
  1.  . S CLASSNAM=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
  1.  . S FOUND=$$MATCH^PXRRPECU(CLASSNAM)
  1.  . I FOUND S CLASSNAM=$P(CLASSNAM,U,7)
  1.  I 'FOUND G PRV
  1.  ;
  1.  ;Primary Provider only.
  1.  I PPONLY D
  1.  . S FOUND=0
  1.  . I PRVIEN>0 D
  1.  .. I $P(^AUPNVPRV(PRVIEN,0),U,4)="P" S FOUND=1
  1.  I 'FOUND G PRV
  1.  ;
  1.  S HLOCNAM=1
  1.  ;By Clinic
  1.  I CLINIC D
  1.  . S CLINIEN=$P(VISIT,U,8)
  1.  . S TEMP=$S(+CLINIEN>0:^DIC(40.7,CLINIEN,0),1:"Unknown")
  1.  . S HLOCNAM=$P(TEMP,U,1)_U_CLINIEN_U_$P(TEMP,U,2)
  1.  ;Clinic screen.
  1.  I CSSCR D
  1.  . S FOUND=0
  1.  . F IC=1:1:NCS I $P(PXRRCS(IC),U,2)=CLINIEN D  Q
  1.  ..;Mark the clinic as being matched.
  1.  .. S $P(PXRRCS(IC),U,4)="M"
  1.  .. S FOUND=1
  1.  I 'FOUND G VISIT
  1.  ;
  1.  ;By hospital location.
  1.  I HLOC D
  1.  . S HLOCIEN=$P(VISIT,U,22)
  1.  . I +HLOCIEN>0 D
  1.  .. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
  1.  .. S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
  1.  .. S TEMP=$S(+CLINIEN>0:^DIC(40.7,CLINIEN,0),1:"")
  1.  .. S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN_U_$P(TEMP,U,2)
  1.  . E  D
  1.  ..;No hospital location, see if we can at least find the clinic.
  1.  .. S HLOCNAM="Unknown"
  1.  .. S CLINIEN=$P(VISIT,U,8)
  1.  .. S TEMP=$S(+CLINIEN>0:^DIC(40.7,CLINIEN,0),1:"")
  1.  .. S HLOCNAM="Unknown"_U_U_$P(TEMP,U,2)
  1.  ;Hospital location screen.
  1.  I HSSCR D
  1.  . S FOUND=0
  1.  . F IC=1:1:NHL I $P(PXRRLCHL(IC),U,2)=HLOCIEN D  Q
  1.  ..;Mark the hospital location as being matched.
  1.  .. S $P(PXRRLCHL(IC),U,4)="M"
  1.  .. S FOUND=1
  1.  I 'FOUND G VISIT
  1.  ;
  1.  ;At this point we have an encounter that can be added to the list.
  1.  S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,VIEN)=""
  1.  ;
  1.  ;Get the next encounter.
  1.  G VISIT
  1.  ;
  1. DONE ;
  1.  D KVAR^VADPT
  1.  I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
  1.  ;
  1.  ;If there were selected clinic stops build dummy entries for all
  1.  ;those without entries.
  1.  I $D(PXRRCS) D
  1.  . F FAC=1:1:NFAC D
  1.  .. S FACILITY=$P(PXRRFAC(FAC),U,1)
  1.  .. F IC=1:1:NCS  D
  1.  ... I $P(PXRRCS(IC),U,4)'="M" D
  1.  .... S PNAME=0
  1.  .... S CLASSNAM=0
  1.  .... S HLOCNAM=PXRRCS(IC)
  1.  .... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,0)=""
  1.  ;
  1.  ;If there were selected hospital locations build dummy entries for all
  1.  ;those without entries.
  1.  I $D(PXRRLCHL) D
  1.  . F FAC=1:1:NFAC D
  1.  .. S FACILITY=$P(PXRRFAC(FAC),U,1)
  1.  .. F IC=1:1:NHL  D
  1.  ... I $P(PXRRLCHL(IC),U,4)'="M" D
  1.  .... S PNAME=0
  1.  .... S CLASSNAM=0
  1.  .... S HLOCNAM=PXRRLCHL(IC)
  1.  .... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,0)=""
  1.  ;
  1.  ;If there were selected providers build dummy entries for all those
  1.  ;without encounters.
  1.  I $D(PXRRPRPL) D
  1.  . N CLASSLST,JC,NPCLASS
  1.  . F FAC=1:1:NFAC D
  1.  .. S FACILITY=$P(PXRRFAC(FAC),U,1)
  1.  .. F IC=1:1:NPL  D
  1.  ... I $P(PXRRPRPL(IC),U,4)'="M" D
  1.  .... S PNAME=$P(PXRRPRPL(IC),U,1,2)
  1.  .... S NEWPIEN=$P(PNAME,U,2)
  1.  ....;Get the person class list for this provider.
  1.  .... S NPCLASS=$$PCLLIST^PXRRPECU(NEWPIEN,PXRRBDT,PXRREDT,.CLASSLST)
  1.  .... F JC=1:1:NPCLASS D
  1.  ..... S TEMP=PNAME_U_CLASSLST(JC)
  1.  ..... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,TEMP,0,0)=""
  1.  ;
  1.  ;If there were person classes build dummy entries for all those
  1.  ;without entries.
  1.  I $D(PXRRPECL) D
  1.  . F FAC=1:1:NFAC D
  1.  .. S FACILITY=$P(PXRRFAC(FAC),U,1)
  1.  .. F IC=1:1:NCL  D
  1.  ... I $P(PXRRPECL(IC),U,4)'="M" D
  1.  .... S PNAME=0
  1.  .... S CLASSNAM=$P(PXRRPECL(IC),U,1,3)
  1.  .... S HLOCNAM=0
  1.  .... S ^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,CLASSNAM,HLOCNAM,0)=""
  1.  ;
  1. EXIT ;
  1.  ;Run the next task in the series.
  1.  I PXRRQUE D
  1.  . N DESC,ROUTINE,TASK
  1.  . S DESC="Frequency of Diagnosis Report - sort diagnosis data"
  1.  . S ROUTINE="SORT^PXRRFDSD"
  1.  . S TASK=^XTMP(PXRRXTMP,"SORTDZTSK")
  1.  . S ZTDTH=$$NOW^XLFDT
  1.  . D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
  1.  E  D SORT^PXRRFDSD
  1.  ;
  1.  Q