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

PXRRWLPR.m

Go to the documentation of this file. 
  1. PXRRWLPR ;ISL/PKR - Print the encounter summary report. ;12/1/97
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
  1.  ;
  1.  N BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,HEAD
  1.  N INDENT,PAGE
  1.  N BY,BYCLOC,EMCODE,EMIND,EMMAX,IC,JC,KC
  1.  N FACILITY,FACPNAME,LOCOPRV,NEM,NOCOUNT,NOEM
  1.  N PCL1,PCL2,POV,POVIND,POVMAX,PRVLOC
  1.  N STOIND,STOP,TEMP,TOTCPT,TOTEM,TOTENC
  1.  N VACODE
  1.  ;
  1.  ;These are the variables used to accumulate the totals.  We want
  1.  ;totals for each facility and a grand total.
  1.  N FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC
  1.  N GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC
  1.  N FTCP,FTSCH,FTTEN,FTTVIS,FTUNS
  1.  N GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS
  1.  ;
  1.  ;Allow the task to be cleaned up upon successful completion.
  1.  S ZTREQ="@"
  1.  ;Check for multiple provider encounters.
  1.  S:$D(^XTMP(PXRRXTMP,"PXRRMPR")) PXRRMPR=1
  1.  ;
  1.  U IO
  1.  S DONE=0
  1.  ;
  1.  ;See if the report is by location or by provider.
  1.  S BY=$O(^XTMP(PXRRXTMP,"STOIND",""))
  1.  ;
  1.  ;See if the report is by clinic location.
  1.  I $P($G(PXRRLCSC),U,1)["C" S BYCLOC=$S($P(PXRRLCSC,U,3):1,1:0)
  1.  E  S BYCLOC=0
  1.  ;
  1.  ;Build a list of the E&M codes.  Use the first 3 characters as an
  1.  ;abbreviation.
  1.  D RETSOC^PXRRWLPF(357.69,.05,.EMCODE)
  1.  S EMMAX=0
  1.  S IC=""
  1.  S JC=0
  1.  F  S IC=$O(EMCODE(IC)) Q:IC=""  D
  1.  . S EMMAX=$$MAX^XLFMTH(EMMAX,$L(EMCODE(IC)))
  1.  . S EMCODE(IC)=EMCODE(IC)_U_$E(EMCODE(IC),1,3)
  1.  . S JC=JC+1
  1.  . S EMIND(JC)=IC
  1.  S NEM=JC
  1.  S EMCODE(0)="TOTAL"_U_"TOTAL"
  1.  ;
  1.  ;Build a list of appointment purposes of visit.  Use the first 4
  1.  ;characters as an abbreviation.
  1.  D RETSOC^PXRRWLPF(2.98,9,.POV)
  1.  S POVMAX=15
  1.  S POV(1)=POV(1)_U_$E(POV(1),1,3)
  1.  S POV(2)=POV(2)_U_$E(POV(2),1,5)
  1.  S POV(3)=POV(3)_U_$E(POV(3),1,3)
  1.  S POV(4)=POV(4)_U_$E(POV(4),1,3)
  1.  S POVIND(1)=1
  1.  S POVIND(2)=2
  1.  S POVIND(3)=3
  1.  S POVIND(4)=4
  1.  ;
  1.  ;Setup initial formatting parameters.
  1.  S INDENT=3
  1.  S (HEAD,PAGE)=1
  1.  S BMARG=2
  1.  D HDR^PXRRGPRT(PAGE)
  1.  W !!,"Criteria for Encounter Summary Report"
  1.  I $P(PXRRWLSC,U,1)="L" D OLRCRIT^PXRRGPRT(INDENT)
  1.  I $P($G(PXRRWLSC),U,1)="P" D OPRCRIT^PXRRGPRT(INDENT)
  1.  ;
  1.  ;Give the abbreviations legend.
  1.  S C1S=0
  1.  S C2S=C1S+EMMAX+5
  1.  S C3S=C2S
  1.  W:PXRRMPR=0 !
  1.  W !,?24,"Abbreviations Used in this Report"
  1.  W !,?C1S,"E&M Codes"
  1.  W ?C2S,"Appointment Type"
  1.  W !,?C1S,"---------"
  1.  ;W ?C2S,"------------------"
  1.  ;W ?C3S,"----------------"
  1.  W ?C2S,"----------------"
  1.  S STOP=0
  1.  S IC=$O(EMCODE(0))
  1.  S KC=$O(POV(""))
  1.  F  D  Q:STOP
  1.  . I $L(IC_KC)=0 S STOP=1 Q
  1.  . E  W !
  1.  . I $L(IC)>0 D
  1.  .. W $P(EMCODE(IC),U,2),"=",$P(EMCODE(IC),U,1)
  1.  .. S IC=$O(EMCODE(IC))
  1.  . I $L(KC)>0 D
  1.  .. W ?C2S,$P(POV(KC),U,2),"=",$P(POV(KC),U,1)
  1.  .. S KC=$O(POV(KC))
  1.  W !,"___________________________________________________________________"
  1.  W:PXRRMPR=1 !,"Note: Encounters with multiple providers are counted once in the totals below"
  1.  ;
  1.  ;Setup the final formatting parameters.
  1.  S C1HS=INDENT+3
  1.  S C1S=0
  1.  S C2HS=C1S+2
  1.  S C2S=C2HS
  1.  S C3HS=C2HS+5
  1.  S C3S=C3HS
  1.  S HEAD=1
  1.  S INDENT=0
  1.  ;
  1.  ;Initialize the grand totals.
  1.  S (GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC)=0
  1.  S (GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS)=0
  1.  ;
  1.  S NOCOUNT=0
  1.  S FACILITY=0
  1. NFAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
  1.  I +FACILITY=0 G DONE
  1.  ;Initialize the facility totals.
  1.  S (FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC)=0
  1.  S (FTCP,FTSCH,FTTEN,FTUNS)=0
  1.  ;Keep track of the facilities that were 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 FACPNAME=$P(PXRRFACN(FACILITY),U,1)_"  "_$P(PXRRFACN(FACILITY),U,2)
  1.  ;
  1.  S STOIND="&&"
  1. NSTO S STOIND=$O(^XTMP(PXRRXTMP,FACILITY,STOIND))
  1.  I STOIND="" D  G NFAC
  1.  . S FTSSN=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTUNIQ"))
  1.  . S FTINP=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",1))
  1.  . S FTOP=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",0))
  1.  . S FTTVIS=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTVIS"))
  1.  . ;Subtract multiple provider encounters from facility total
  1.  . I PXRRMPR=1 D NCSUB
  1.  . D WFACTOT^PXRRWLPF
  1.  . D GTOTAL^PXRRWLPF
  1.  D HEAD^PXRRWLPF(0)
  1.  I DONE G DONE
  1.  I '$D(PXRRPRLL) S PXRRPRLL=0
  1.  S LOCOPRV=" "
  1.  I BY="LOCATION" D
  1.  . S LOCOPRV=$P(STOIND,U,1)_" ("_$P(STOIND,U,3)_")"
  1.  . S NOCOUNT=0
  1.  . S INDENT=0
  1.  .;If we have clinic stops split out by clinic location do not include
  1.  .;the individual locations in the totals.
  1.  . I (BYCLOC)&($L(STOIND,U)=4) D
  1.  .. S LOCOPRV=$P(STOIND,U,4)_" ("_$P(STOIND,U,3)_")"
  1.  .. S NOCOUNT=1
  1.  .. S INDENT=2
  1.  I BY="PROVIDER" D
  1.  . S VACODE=$P(STOIND,U,3)
  1.  . S TEMP=$$ABBRV^PXRRPECU(VACODE)
  1.  . K PCL1,PCL2
  1.  . D FMTPCL^PXRRPRSP(TEMP,$L($P(STOIND,U,1))+1,80,.PCL1,.PCL2)
  1.  . S LOCOPRV=$P(STOIND,U,1)_" "_PCL1
  1.  . I PXRRPRLL S PRVLOC=$P(STOIND,U,4)_" ("_$P(STOIND,U,6)_")"
  1.  ;
  1.  ;Write out the PCE encounter data.
  1.  S TOTCPT=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT"))
  1.  S TOTENC=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC"))
  1.  S NOEM=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",0))
  1.  I $Y>(IOSL-BMARG-5) D HEAD^PXRRWLPF(1)
  1.  I DONE G DONE
  1.  W !!,?INDENT,LOCOPRV
  1.  I PXRRPRLL W !,?C1HS,PRVLOC
  1.  I $D(PCL2) W !," ",PCL2
  1.  W !,?C2HS,"PCE:"
  1.  S TOTEM=0
  1.  ;E&M new.
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(1)))
  1.  W ?C3S,$J(TEMP,6)
  1.  D NCSUM(.FTNEW,TEMP,NOCOUNT)
  1.  D NCSUM(.TOTEM,TEMP,NOCOUNT)
  1.  ;E&M established.
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(2)))
  1.  W $J(TEMP,6)
  1.  D NCSUM(.FTEST,TEMP,NOCOUNT)
  1.  D NCSUM(.TOTEM,TEMP,NOCOUNT)
  1.  ;E&M consult.
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(3)))
  1.  W $J(TEMP,6)
  1.  D NCSUM(.FTCON,TEMP,NOCOUNT)
  1.  D NCSUM(.TOTEM,TEMP,NOCOUNT)
  1.  ;E&M other
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(4)))
  1.  W $J(TEMP,6)
  1.  D NCSUM(.FTOTH,TEMP,NOCOUNT)
  1.  D NCSUM(.TOTEM,TEMP,NOCOUNT)
  1.  W $J(NOEM,6)
  1.  D NCSUM(.FTNOEM,NOEM,NOCOUNT)
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT"))
  1.  W $J(TEMP,6)
  1.  D NCSUM(.FTNOCPT,TEMP,NOCOUNT)
  1.  W $J(TOTENC,7)
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTVIS"))
  1.  W $J(TEMP,6)
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"UPAT"))
  1.  W $J(TEMP,6)
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",1))
  1.  W $J(TEMP,6)
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",0))
  1.  W $J(TEMP,6)
  1.  ;
  1.  D NCSUM(.FTTENC,TOTENC,NOCOUNT)
  1.  ;
  1.  ;Write the appointment info.
  1.  W !,?C2HS F IC=C2HS+1:1:80 W "-"
  1.  W !,?C2HS,"SCH:"
  1.  ;Purpose of Visit C&P.
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(1)))
  1.  W ?C3S,$J(TEMP,6)
  1.  D NCSUM(.FTCP,TEMP,NOCOUNT)
  1.  ;Purpose of Visit 10-10.
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(2)))
  1.  W $J(TEMP,6)
  1.  D NCSUM(.FTTEN,TEMP,NOCOUNT)
  1.  ;Purpose of Visit scheduled.
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(3)))
  1.  W $J(TEMP,6)
  1.  D NCSUM(.FTSCH,TEMP,NOCOUNT)
  1.  ;Purpose of Visit unscheduled.
  1.  S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(4)))
  1.  W $J(TEMP,6)
  1.  D NCSUM(.FTUNS,TEMP,NOCOUNT)
  1.  ;
  1.  G NSTO
  1. DONE ;
  1.  I DONE G EXIT
  1.  I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
  1.  I DONE G EXIT
  1.  I GTTENC>0 D WGTOTAL^PXRRWLPF
  1.  I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
  1.  I DONE G EXIT
  1.  D FACNE^PXRRGPRT(INDENT)
  1. EXIT ;
  1.  ;Clean up
  1.  D EXIT^PXRRGUT
  1.  D EOR^PXRRGUT
  1.  Q
  1.  ;
  1.  ;=======================================================================
  1. NCSUM(VAR,ADD,NOCOUNT) ;No Count summation function.  Only add to VAR if
  1.  ; NOCOUNT is false.
  1.  I NOCOUNT Q
  1.  S VAR=VAR+ADD
  1.  Q
  1.  ;
  1. NCSUB ;Subtract multiple provider totals from facility totals
  1.  ;Totals are built in PXRRWLS2,PXRRWLSE and PXRRWLSA
  1.  N FTFLDS,FTFLD,FTEMP
  1.  ;E&M codes
  1.  S EMIND(0)=0
  1.  S FTFLDS="FTNOEM;FTNEW;FTEST;FTCON;FTOTH"
  1.  F JJ=0:1:4 D
  1.  . S FTFLD=$P(FTFLDS,";",JJ+1)
  1.  . S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","EM",EMIND(JJ)))
  1.  . S @FTFLD=@FTFLD-FTEMP
  1.  ;Purpose of visit codes
  1.  S FTFLDS="FTCP;FTTEN;FTSCH;FTUNS"
  1.  F JJ=1:1:4 D
  1.  . S FTFLD=$P(FTFLDS,";",JJ)
  1.  . S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","POV",POVIND(JJ)))
  1.  . S @FTFLD=@FTFLD-FTEMP
  1.  ;Miscellaneous
  1.  S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","TOTENC"))
  1.  S FTTENC=FTTENC-FTEMP
  1.  S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT"))
  1.  S FTNOCPT=FTNOCPT-FTEMP
  1.  Q