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

PXRRPRDP.m

Go to the documentation of this file.
  1. PXRRPRDP ;ISL/PKR - Provider encounter detailed print. ;2/26/98
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,48,189**;Aug 12, 1996;Build 13
  1. ;
  1. N BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,INDENT,MID,PAGE
  1. N CLASSNAM,CLINNAM
  1. N DATE,DAY,DTOTAL,GTOTAL,HLOC,HLOCMAX,IC
  1. N FACILITY,FACPNAME,FTOTAL
  1. N OCC,NEWPIEN,PCLASS,PNAME,PPNAME,PTOTAL
  1. N SPEC,SUBSPEC,TEMP,VACODE,VIEN
  1. ;
  1. ;Allow the task to be cleaned up upon successful completion.
  1. S ZTREQ="@"
  1. ;
  1. U IO
  1. S DONE=0
  1. ;Setup the formatting parameters.
  1. S HLOCMAX=^XTMP(PXRRXTMP,"HLOCMAX")
  1. S INDENT=3
  1. S C1HS=INDENT+4
  1. S C2HS=INDENT+15
  1. S C3HS=C2HS+45
  1. ;We assume that the counts will never be longer than six digits.
  1. S MID=C3HS+6
  1. S C1S=C2HS+HLOCMAX+1
  1. S C2S=C1S+7
  1. ;
  1. S PAGE=1
  1. S GTOTAL=0
  1. I ($E(IOST)="C")&(IO=IO(0)) S BMARG=3
  1. E S BMARG=2
  1. D HDR^PXRRGPRT(PAGE)
  1. W !!,"Criteria for Provider Encounter Detailed Report"
  1. D OPRCRIT^PXRRGPRT(3)
  1. ;
  1. SET ;Set up print fields
  1. S FACILITY=0
  1. FAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
  1. ; Fix to include Non-VA site - *189
  1. I (+FACILITY=0)&(FACILITY'="*") G FINAL
  1. ;Mark the facility as being found.
  1. F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
  1. . S $P(PXRRFAC(IC),U,4)="M"
  1. S FTOTAL=0
  1. S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
  1. S HAVEPRV=0
  1. D HEAD(HAVEPRV)
  1. ;
  1. S PNAME=0
  1. PRV S PNAME=$O(^XTMP(PXRRXTMP,FACILITY,PNAME))
  1. I PNAME="" D G FAC
  1. . S TEMP="Total facility encounters "
  1. . I $Y>(IOSL-BMARG-1) D HEAD(HAVEPRV)
  1. . I 'DONE D
  1. .. D PTOTAL^PXRRGPRT(TEMP,FTOTAL,MID,0)
  1. .. S GTOTAL=GTOTAL+FTOTAL
  1. .. I $D(PXRRPECL) D CLASSNE^PXRRGPRT(INDENT)
  1. I DONE G END
  1. S PPNAME=$P(PNAME,U,1)
  1. S NEWPIEN=$P(PNAME,U,2)
  1. ;
  1. ;Check for a user request to stop the task.
  1. I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
  1. ;
  1. S CLASSNAM=0
  1. CLASS ;
  1. I DONE G END
  1. S CLASSNAM=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM))
  1. I CLASSNAM="" D G PRV
  1. . K ^TMP(PXRRXTMP,$J,PNAME)
  1. S VACODE=$P(CLASSNAM,U,2)
  1. I $L(VACODE)>0 D
  1. . S PCLASS=$$OCCUP^PXBGPRV("","",VACODE,1)
  1. . S OCCUP=$P(PCLASS,U,2)
  1. . S SPEC=$P(PCLASS,U,3)
  1. . S SUBSPEC=$P(PCLASS,U,4)
  1. E D
  1. . S PCLASS=-3
  1. . S OCCUP="Unknown"
  1. . S SPEC=""
  1. . S SUBSPEC=""
  1. ;If we are doing selected person classes keep track of the ones we
  1. ;found.
  1. I $D(PXRRPECL) S TEMP=$$MATCH^PXRRPECU(PCLASS)
  1. S (DATE,PTOTAL)=0
  1. I DONE G END
  1. D PPRINT
  1. S HAVEPRV=1
  1. ;
  1. DATE ;
  1. S DATE=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE))
  1. I DATE="" D G CLASS
  1. .;Print the daily totals and get the total count.
  1. . D DPRINT(.PTOTAL)
  1. . I 'DONE D
  1. .. S TEMP="Total encounters for "_PPNAME_" "
  1. .. I $Y>(IOSL-BMARG-3) D HEAD(HAVEPRV)
  1. .. I 'DONE D
  1. ... D PTOTAL^PXRRGPRT(TEMP,PTOTAL,MID,1)
  1. ... S HAVEPRV=0
  1. ... S FTOTAL=FTOTAL+PTOTAL
  1. I DONE G END
  1. ;
  1. S HLOC=0
  1. HLO S HLOC=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC))
  1. I HLOC="" G DATE
  1. ;
  1. ;Build a ^TMP array of all the visits for the current provider.
  1. S DAY=$P(DATE,".",1)
  1. S VIEN=0
  1. F S VIEN=$O(^XTMP(PXRRXTMP,FACILITY,PNAME,CLASSNAM,DATE,HLOC,VIEN)) Q:+VIEN=0 D
  1. . S ^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN)=""
  1. G HLO
  1. ;
  1. FINAL ;Print grand totals.
  1. I DONE G END
  1. I GTOTAL>0 D
  1. . S TEMP="Total encounters "
  1. . I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
  1. . I 'DONE D PTOTAL^PXRRGPRT(TEMP,GTOTAL,MID,0)
  1. I DONE G END
  1. ;Check for facilities that were listed but had no encounters.
  1. D FACNE^PXRRGPRT(INDENT)
  1. END ;
  1. D EXIT^PXRRGUT
  1. D EOR^PXRRGUT
  1. Q
  1. ;
  1. ;=======================================================================
  1. DPRINT(PTOTAL) ;Print the daily totals and return the total provider count.
  1. N DAY,HLOC,HLOCNAM,NVISITS,SC,SCAT,VIEN,VISITS
  1. S PTOTAL=0
  1. S DAY=0
  1. NDAY S DAY=$O(^TMP(PXRRXTMP,$J,PNAME,DAY))
  1. I DAY="" Q
  1. ;
  1. S HLOC=""
  1. NHLOC S HLOC=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC))
  1. S HLOCNAM=$P(HLOC,U,1)
  1. S SC=$P(HLOC,U,3)
  1. I HLOC="" G NDAY
  1. ;
  1. S NVISITS=0
  1. K VISITS
  1. S VIEN=0
  1. NVIEN S VIEN=$O(^TMP(PXRRXTMP,$J,PNAME,DAY,HLOC,VIEN))
  1. I VIEN="" D G NHLOC
  1. . S SCAT=$$SCAT(NVISITS,.VISITS)
  1. . S PTOTAL=PTOTAL+NVISITS
  1. . S C3S=MID-$L(NVISITS)
  1. . I $Y>(IOSL-BMARG-3) D HEAD(HAVEPRV)
  1. . I 'DONE D
  1. .. W !,?INDENT,$$FMTE^XLFDT(DAY,"1D"),?C2HS,HLOCNAM
  1. .. W ?C1S,SC,?C2S,SCAT,?C3S,NVISITS
  1. I DONE Q
  1. S NVISITS=NVISITS+1
  1. S VISITS(NVISITS)=VIEN
  1. G NVIEN
  1. Q
  1. ;
  1. ;=======================================================================
  1. N LEN,TEMP,VACODE
  1. I $Y>(IOSL-BMARG-7) D PAGE^PXRRGPRT
  1. I DONE Q
  1. W !!,"Facility: ",FACPNAME
  1. W !!,"Provider - Person Class"
  1. W !,?C1HS,"Date",?C2HS,"Hos. Loc. (Stop Code) Serv. Cat.",?C3HS,"Encounters"
  1. W !,?INDENT,"------------",?C2HS,"------------------------------------------",?C3HS,"----------"
  1. I $G(HAVEPRV) W !,PPNAME," (continued)"
  1. Q
  1. ;
  1. ;=======================================================================
  1. PPRINT ;Print the provider information.
  1. I $Y>(IOSL-BMARG-4) D HEAD(HAVEPRV)
  1. I DONE Q
  1. S TEMP=PPNAME_" - "_OCCUP
  1. S LEN=$L(TEMP)
  1. I LEN>C3HS D
  1. . W !,PPNAME," - "
  1. . W !?3,OCCUP
  1. . I $L(SPEC)>0 W !,?4,SPEC
  1. . I $L(SUBSPEC)>0 W !,?5,SUBSPEC
  1. E D
  1. . W !,TEMP
  1. . I $L(SPEC)>0 W !,?4,SPEC
  1. . I $L(SUBSPEC)>0 W !,?5,SUBSPEC
  1. W !
  1. Q
  1. ;
  1. ;=======================================================================
  1. SCAT(NVISITS,VISITS) ;Given a list of VISIT IENS return the service categories.
  1. ;
  1. N IC,SCATL,VISIT
  1. S SCATL=""
  1. F IC=1:1:NVISITS D
  1. . S VISIT=^AUPNVSIT(VISITS(IC),0)
  1. . S SCATL=$$USTRINS^PXRRGUT(SCATL,$P(VISIT,U,7))
  1. Q SCATL
  1. ;