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

PXRRECSE.m

Go to the documentation of this file. 
  1. PXRRECSE ;ISL/PKR - Sort through encounters applying the selection criteria. ;6/27/97
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,72**;Aug 12, 1996
  1. SORT ;
  1.  N BD,BUSY,CLASSNAM,CLINIC,CLINIEN,CSSCR
  1.  N ED,IC,FAC,FACILITY,FOUND
  1.  N HLOCIEN,HLOCNAM,HLOCMAX,HSSCR,NEWPIEN
  1.  N PCLMAX,PCLASS,PNAME,PNMAX,PPNAME,PPONLY,PRVCNT,PRVIEN
  1.  N TEMP,VACODE,VIEN,VISIT
  1.  ;
  1.  S (HLOCMAX,PCLMAX,PNMAX)=0
  1.  ;
  1.  I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
  1.  ;
  1.  ;CSSCR is true if we want selected clinics.
  1.  I $P($G(PXRRLCSC),U,1)="CS" S CSSCR=1
  1.  E  S CSSCR=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.  ;PPONLY is true if we want primary providers only.
  1.  I $P($G(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.  ;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.  ;Check for a user request to stop the task.
  1.  I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
  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.  ;Screen out inappropriate vists.
  1.  I PXRRSCAT'[$P(VISIT,U,7) 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.  ;
  1.  ;If category was an encounter, check if encounter
  1.  ;occurred at a non-VA site
  1.  I PXRRSCAT["E"&($P(VISIT,U,7)="E")&(FAC="")&($D(NONVA)) D
  1.  . I $D(^AUPNVSIT(VIEN,21)) S FACILITY="*",FOUND=1
  1.  ;
  1.  I 'FOUND G VISIT
  1.  ;
  1.  ;Get the Provider
  1.  S PRVCNT=0
  1.  S PRVIEN=0
  1. PRV ;
  1.  S PRVIEN=$O(^AUPNVPRV("AD",VIEN,PRVIEN))
  1.  I (PRVIEN="")&(PRVCNT>0) G VISIT
  1.  I (PRVIEN="") D
  1.  . S NEWPIEN=0
  1.  E  D
  1.  . S NEWPIEN=$P(^AUPNVPRV(PRVIEN,0),U,1)
  1.  S PRVCNT=PRVCNT+1
  1.  S (CLASSNAM,HLOCNAM,PPNAME)=""
  1.  S FOUND=1
  1.  ;
  1.  ;Apply any Provider screens.
  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 matched.
  1.  .. S $P(PXRRPRPL(IC),U,4)="M"
  1.  .. S PPNAME=$P(PXRRPRPL(IC),U,1)
  1.  .. S FOUND=1
  1.  I 'FOUND G PRV
  1.  ;
  1.  ;Get the Person Class.
  1.  S PCLASS=$$OCCUP^PXBGPRV(NEWPIEN,BD,"",1,"")
  1.  ;
  1.  ;Person class screen.
  1.  I $D(PXRRPECL) D
  1.  . S FOUND=$$MATCH^PXRRPECU(PCLASS)
  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.  ;Clinic screen.
  1.  I CSSCR D
  1.  . S FOUND=0
  1.  . S CLINIEN=$P(VISIT,U,8)
  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 HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
  1.  .. S FOUND=1
  1.  I 'FOUND G PRV
  1.  ;
  1.  ;Hospital location screen.
  1.  I HSSCR D
  1.  . S FOUND=0
  1.  . S HLOCIEN=$P(VISIT,U,22)
  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 HLOCNAM=$P(^SC(HLOCIEN,0),U,1)_U_HLOCIEN
  1.  .. S CLINIEN=$P(^SC(HLOCIEN,0),U,7)
  1.  .. S FOUND=1
  1.  I 'FOUND G PRV
  1.  ;
  1.  ;At this point we have an encounter that can be added to the list.
  1.  ;Make sure we have a Provider name.
  1.  I NEWPIEN=0 S PPNAME="Unknown"
  1.  I $L(PPNAME)=0 D
  1.  . S PPNAME=$P($G(^VA(200,NEWPIEN,0)),U,1)
  1.  . I $L(PPNAME)=0 S PPNAME="Unknown",NEWPIEN=0
  1.  S PNMAX=$$MAX^XLFMTH(PNMAX,$L(PPNAME))
  1.  S PNAME=PPNAME_U_NEWPIEN
  1.  ;
  1.  ;Make sure we have a Person Class.
  1.  I +$P($G(PCLASS),U,1)'>0 D
  1.  . S CLASSNAM="Unknown"
  1.  . S TEMP=CLASSNAM
  1.  E  D
  1.  . S VACODE=$P(PCLASS,U,7)
  1.  . S CLASSNAM=$$ALPHA^PXRRPECU(PCLASS)
  1.  . S TEMP=$$ABBRV^PXRRPECU(VACODE)
  1.  S PCLMAX=$$MAX^XLFMTH(PCLMAX,$L(TEMP))
  1.  ;
  1.  ;Get the hospital location or clinic and stop code.
  1.  I $L(HLOCNAM)'>0 D
  1.  . I 'CLINIC D
  1.  .. ;Get the hospital location.
  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.  .. 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.  .. I PXRRSCAT["E"&($P(VISIT,U,7)="E")&(FAC="") D
  1.  ...; If encounter occurred outside VA get location from node 21
  1.  ...S HLOCNAM=$P(^AUPNVSIT(VIEN,21),U,1)
  1.  . E  D
  1.  .. ;Get the clinic.
  1.  .. S CLINIEN=$P(VISIT,U,8)
  1.  .. I CLINIEN>0 S HLOCNAM=$P(^DIC(40.7,CLINIEN,0),U,1)_U_CLINIEN
  1.  .. E  S HLOCNAM="Unknown"
  1.  ;
  1.  ;Append the clinic stop code.
  1.  I CLINIEN>0 S HLOCNAM=HLOCNAM_U_$P(^DIC(40.7,CLINIEN,0),U,2)
  1.  S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
  1.  ;
  1.  S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,BD,HLOCNAM,VIEN)=""
  1.  ;
  1.  ;Get the next provider.
  1.  G PRV
  1.  ;
  1. DONE ;
  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="Unknown"_U_"0"
  1.  .... S CLASSNAM="Unknown"
  1.  .... S HLOCNAM=PXRRCS(IC)
  1.  .... S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
  1.  .... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,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="Unknown"_U_"0"
  1.  .... S CLASSNAM="Unknown"
  1.  .... S HLOCNAM=PXRRLCHL(IC)
  1.  .... S HLOCMAX=$$MAX^XLFMTH(HLOCMAX,$L($P(HLOCNAM,U,1)))
  1.  .... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,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=PXRRPRPL(IC)
  1.  .... S PPNAME=$P(PNAME,U,1)
  1.  .... S PNMAX=$$MAX^XLFMTH(PNMAX,$L(PPNAME))
  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 CLASSNAM=CLASSLST(JC)
  1.  ..... S VACODE=$P(CLASSNAM,U,2)
  1.  ..... I $L(VACODE)'>0 S TEMP="Unknown"
  1.  ..... E  S TEMP=$$ABBRV^PXRRPECU(VACODE)
  1.  ..... S PCLMAX=$$MAX^XLFMTH(PCLMAX,$L(TEMP))
  1.  ..... S ^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,0,"HLOC")=0
  1.  ;
  1. EXIT ;Save the values of HLOCMAX, PCLMAX,and PNMAX.
  1.  S ^XTMP(PXRRXTMP,"HLOCMAX")=HLOCMAX
  1.  S ^XTMP(PXRRXTMP,"PCLMAX")=PCLMAX
  1.  S ^XTMP(PXRRXTMP,"PNMAX")=PNMAX
  1.  ;
  1.  Q