PXRRWLPR ;ISL/PKR - Print the encounter summary report. ;12/1/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
;
N BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,HEAD
N INDENT,PAGE
N BY,BYCLOC,EMCODE,EMIND,EMMAX,IC,JC,KC
N FACILITY,FACPNAME,LOCOPRV,NEM,NOCOUNT,NOEM
N PCL1,PCL2,POV,POVIND,POVMAX,PRVLOC
N STOIND,STOP,TEMP,TOTCPT,TOTEM,TOTENC
N VACODE
;
;These are the variables used to accumulate the totals. We want
;totals for each facility and a grand total.
N FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC
N GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC
N FTCP,FTSCH,FTTEN,FTTVIS,FTUNS
N GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS
;
;Allow the task to be cleaned up upon successful completion.
S ZTREQ="@"
;Check for multiple provider encounters.
S:$D(^XTMP(PXRRXTMP,"PXRRMPR")) PXRRMPR=1
;
U IO
S DONE=0
;
;See if the report is by location or by provider.
S BY=$O(^XTMP(PXRRXTMP,"STOIND",""))
;
;See if the report is by clinic location.
I $P($G(PXRRLCSC),U,1)["C" S BYCLOC=$S($P(PXRRLCSC,U,3):1,1:0)
E S BYCLOC=0
;
;Build a list of the E&M codes. Use the first 3 characters as an
;abbreviation.
D RETSOC^PXRRWLPF(357.69,.05,.EMCODE)
S EMMAX=0
S IC=""
S JC=0
F S IC=$O(EMCODE(IC)) Q:IC="" D
. S EMMAX=$$MAX^XLFMTH(EMMAX,$L(EMCODE(IC)))
. S EMCODE(IC)=EMCODE(IC)_U_$E(EMCODE(IC),1,3)
. S JC=JC+1
. S EMIND(JC)=IC
S NEM=JC
S EMCODE(0)="TOTAL"_U_"TOTAL"
;
;Build a list of appointment purposes of visit. Use the first 4
;characters as an abbreviation.
D RETSOC^PXRRWLPF(2.98,9,.POV)
S POVMAX=15
S POV(1)=POV(1)_U_$E(POV(1),1,3)
S POV(2)=POV(2)_U_$E(POV(2),1,5)
S POV(3)=POV(3)_U_$E(POV(3),1,3)
S POV(4)=POV(4)_U_$E(POV(4),1,3)
S POVIND(1)=1
S POVIND(2)=2
S POVIND(3)=3
S POVIND(4)=4
;
;Setup initial formatting parameters.
S INDENT=3
S (HEAD,PAGE)=1
S BMARG=2
D HDR^PXRRGPRT(PAGE)
W !!,"Criteria for Encounter Summary Report"
I $P(PXRRWLSC,U,1)="L" D OLRCRIT^PXRRGPRT(INDENT)
I $P($G(PXRRWLSC),U,1)="P" D OPRCRIT^PXRRGPRT(INDENT)
;
;Give the abbreviations legend.
S C1S=0
S C2S=C1S+EMMAX+5
S C3S=C2S
W:PXRRMPR=0 !
W !,?24,"Abbreviations Used in this Report"
W !,?C1S,"E&M Codes"
W ?C2S,"Appointment Type"
W !,?C1S,"---------"
;W ?C2S,"------------------"
;W ?C3S,"----------------"
W ?C2S,"----------------"
S STOP=0
S IC=$O(EMCODE(0))
S KC=$O(POV(""))
F D Q:STOP
. I $L(IC_KC)=0 S STOP=1 Q
. E W !
. I $L(IC)>0 D
.. W $P(EMCODE(IC),U,2),"=",$P(EMCODE(IC),U,1)
.. S IC=$O(EMCODE(IC))
. I $L(KC)>0 D
.. W ?C2S,$P(POV(KC),U,2),"=",$P(POV(KC),U,1)
.. S KC=$O(POV(KC))
W !,"___________________________________________________________________"
W:PXRRMPR=1 !,"Note: Encounters with multiple providers are counted once in the totals below"
;
;Setup the final formatting parameters.
S C1HS=INDENT+3
S C1S=0
S C2HS=C1S+2
S C2S=C2HS
S C3HS=C2HS+5
S C3S=C3HS
S HEAD=1
S INDENT=0
;
;Initialize the grand totals.
S (GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC)=0
S (GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS)=0
;
S NOCOUNT=0
S FACILITY=0
NFAC S FACILITY=$O(^XTMP(PXRRXTMP,FACILITY))
I +FACILITY=0 G DONE
;Initialize the facility totals.
S (FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC)=0
S (FTCP,FTSCH,FTTEN,FTUNS)=0
;Keep track of the facilities that were found.
F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
. S $P(PXRRFAC(IC),U,4)="M"
S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
;
S STOIND="&&"
NSTO S STOIND=$O(^XTMP(PXRRXTMP,FACILITY,STOIND))
I STOIND="" D G NFAC
. S FTSSN=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTUNIQ"))
. S FTINP=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",1))
. S FTOP=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",0))
. S FTTVIS=+$G(^XTMP(PXRRXTMP,FACILITY,"&","TOTVIS"))
. ;Subtract multiple provider encounters from facility total
. I PXRRMPR=1 D NCSUB
. D WFACTOT^PXRRWLPF
. D GTOTAL^PXRRWLPF
D HEAD^PXRRWLPF(0)
I DONE G DONE
I '$D(PXRRPRLL) S PXRRPRLL=0
S LOCOPRV=" "
I BY="LOCATION" D
. S LOCOPRV=$P(STOIND,U,1)_" ("_$P(STOIND,U,3)_")"
. S NOCOUNT=0
. S INDENT=0
.;If we have clinic stops split out by clinic location do not include
.;the individual locations in the totals.
. I (BYCLOC)&($L(STOIND,U)=4) D
.. S LOCOPRV=$P(STOIND,U,4)_" ("_$P(STOIND,U,3)_")"
.. S NOCOUNT=1
.. S INDENT=2
I BY="PROVIDER" D
. S VACODE=$P(STOIND,U,3)
. S TEMP=$$ABBRV^PXRRPECU(VACODE)
. K PCL1,PCL2
. D FMTPCL^PXRRPRSP(TEMP,$L($P(STOIND,U,1))+1,80,.PCL1,.PCL2)
. S LOCOPRV=$P(STOIND,U,1)_" "_PCL1
. I PXRRPRLL S PRVLOC=$P(STOIND,U,4)_" ("_$P(STOIND,U,6)_")"
;
;Write out the PCE encounter data.
S TOTCPT=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT"))
S TOTENC=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC"))
S NOEM=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",0))
I $Y>(IOSL-BMARG-5) D HEAD^PXRRWLPF(1)
I DONE G DONE
W !!,?INDENT,LOCOPRV
I PXRRPRLL W !,?C1HS,PRVLOC
I $D(PCL2) W !," ",PCL2
W !,?C2HS,"PCE:"
S TOTEM=0
;E&M new.
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(1)))
W ?C3S,$J(TEMP,6)
D NCSUM(.FTNEW,TEMP,NOCOUNT)
D NCSUM(.TOTEM,TEMP,NOCOUNT)
;E&M established.
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(2)))
W $J(TEMP,6)
D NCSUM(.FTEST,TEMP,NOCOUNT)
D NCSUM(.TOTEM,TEMP,NOCOUNT)
;E&M consult.
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(3)))
W $J(TEMP,6)
D NCSUM(.FTCON,TEMP,NOCOUNT)
D NCSUM(.TOTEM,TEMP,NOCOUNT)
;E&M other
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(4)))
W $J(TEMP,6)
D NCSUM(.FTOTH,TEMP,NOCOUNT)
D NCSUM(.TOTEM,TEMP,NOCOUNT)
W $J(NOEM,6)
D NCSUM(.FTNOEM,NOEM,NOCOUNT)
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT"))
W $J(TEMP,6)
D NCSUM(.FTNOCPT,TEMP,NOCOUNT)
W $J(TOTENC,7)
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTVIS"))
W $J(TEMP,6)
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"UPAT"))
W $J(TEMP,6)
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",1))
W $J(TEMP,6)
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",0))
W $J(TEMP,6)
;
D NCSUM(.FTTENC,TOTENC,NOCOUNT)
;
;Write the appointment info.
W !,?C2HS F IC=C2HS+1:1:80 W "-"
W !,?C2HS,"SCH:"
;Purpose of Visit C&P.
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(1)))
W ?C3S,$J(TEMP,6)
D NCSUM(.FTCP,TEMP,NOCOUNT)
;Purpose of Visit 10-10.
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(2)))
W $J(TEMP,6)
D NCSUM(.FTTEN,TEMP,NOCOUNT)
;Purpose of Visit scheduled.
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(3)))
W $J(TEMP,6)
D NCSUM(.FTSCH,TEMP,NOCOUNT)
;Purpose of Visit unscheduled.
S TEMP=+$G(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(4)))
W $J(TEMP,6)
D NCSUM(.FTUNS,TEMP,NOCOUNT)
;
G NSTO
DONE ;
I DONE G EXIT
I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
I DONE G EXIT
I GTTENC>0 D WGTOTAL^PXRRWLPF
I $Y>(IOSL-BMARG-3) D PAGE^PXRRGPRT
I DONE G EXIT
D FACNE^PXRRGPRT(INDENT)
EXIT ;
;Clean up
D EXIT^PXRRGUT
D EOR^PXRRGUT
Q
;
;=======================================================================
NCSUM(VAR,ADD,NOCOUNT) ;No Count summation function. Only add to VAR if
; NOCOUNT is false.
I NOCOUNT Q
S VAR=VAR+ADD
Q
;
NCSUB ;Subtract multiple provider totals from facility totals
;Totals are built in PXRRWLS2,PXRRWLSE and PXRRWLSA
N FTFLDS,FTFLD,FTEMP
;E&M codes
S EMIND(0)=0
S FTFLDS="FTNOEM;FTNEW;FTEST;FTCON;FTOTH"
F JJ=0:1:4 D
. S FTFLD=$P(FTFLDS,";",JJ+1)
. S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","EM",EMIND(JJ)))
. S @FTFLD=@FTFLD-FTEMP
;Purpose of visit codes
S FTFLDS="FTCP;FTTEN;FTSCH;FTUNS"
F JJ=1:1:4 D
. S FTFLD=$P(FTFLDS,";",JJ)
. S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","POV",POVIND(JJ)))
. S @FTFLD=@FTFLD-FTEMP
;Miscellaneous
S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","TOTENC"))
S FTTENC=FTTENC-FTEMP
S FTEMP=+$G(^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT"))
S FTNOCPT=FTNOCPT-FTEMP
Q
PXRRWLPR ;ISL/PKR - Print the encounter summary report. ;12/1/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
+2 ;
+3 NEW BMARG,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,HEAD
+4 NEW INDENT,PAGE
+5 NEW BY,BYCLOC,EMCODE,EMIND,EMMAX,IC,JC,KC
+6 NEW FACILITY,FACPNAME,LOCOPRV,NEM,NOCOUNT,NOEM
+7 NEW PCL1,PCL2,POV,POVIND,POVMAX,PRVLOC
+8 NEW STOIND,STOP,TEMP,TOTCPT,TOTEM,TOTENC
+9 NEW VACODE
+10 ;
+11 ;These are the variables used to accumulate the totals. We want
+12 ;totals for each facility and a grand total.
+13 NEW FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC
+14 NEW GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC
+15 NEW FTCP,FTSCH,FTTEN,FTTVIS,FTUNS
+16 NEW GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS
+17 ;
+18 ;Allow the task to be cleaned up upon successful completion.
+19 SET ZTREQ="@"
+20 ;Check for multiple provider encounters.
+21 IF $DATA(^XTMP(PXRRXTMP,"PXRRMPR"))
SET PXRRMPR=1
+22 ;
+23 USE IO
+24 SET DONE=0
+25 ;
+26 ;See if the report is by location or by provider.
+27 SET BY=$ORDER(^XTMP(PXRRXTMP,"STOIND",""))
+28 ;
+29 ;See if the report is by clinic location.
+30 IF $PIECE($GET(PXRRLCSC),U,1)["C"
SET BYCLOC=$SELECT($PIECE(PXRRLCSC,U,3):1,1:0)
+31 IF '$TEST
SET BYCLOC=0
+32 ;
+33 ;Build a list of the E&M codes. Use the first 3 characters as an
+34 ;abbreviation.
+35 DO RETSOC^PXRRWLPF(357.69,.05,.EMCODE)
+36 SET EMMAX=0
+37 SET IC=""
+38 SET JC=0
+39 FOR
SET IC=$ORDER(EMCODE(IC))
IF IC=""
QUIT
Begin DoDot:1
+40 SET EMMAX=$$MAX^XLFMTH(EMMAX,$LENGTH(EMCODE(IC)))
+41 SET EMCODE(IC)=EMCODE(IC)_U_$EXTRACT(EMCODE(IC),1,3)
+42 SET JC=JC+1
+43 SET EMIND(JC)=IC
End DoDot:1
+44 SET NEM=JC
+45 SET EMCODE(0)="TOTAL"_U_"TOTAL"
+46 ;
+47 ;Build a list of appointment purposes of visit. Use the first 4
+48 ;characters as an abbreviation.
+49 DO RETSOC^PXRRWLPF(2.98,9,.POV)
+50 SET POVMAX=15
+51 SET POV(1)=POV(1)_U_$EXTRACT(POV(1),1,3)
+52 SET POV(2)=POV(2)_U_$EXTRACT(POV(2),1,5)
+53 SET POV(3)=POV(3)_U_$EXTRACT(POV(3),1,3)
+54 SET POV(4)=POV(4)_U_$EXTRACT(POV(4),1,3)
+55 SET POVIND(1)=1
+56 SET POVIND(2)=2
+57 SET POVIND(3)=3
+58 SET POVIND(4)=4
+59 ;
+60 ;Setup initial formatting parameters.
+61 SET INDENT=3
+62 SET (HEAD,PAGE)=1
+63 SET BMARG=2
+64 DO HDR^PXRRGPRT(PAGE)
+65 WRITE !!,"Criteria for Encounter Summary Report"
+66 IF $PIECE(PXRRWLSC,U,1)="L"
DO OLRCRIT^PXRRGPRT(INDENT)
+67 IF $PIECE($GET(PXRRWLSC),U,1)="P"
DO OPRCRIT^PXRRGPRT(INDENT)
+68 ;
+69 ;Give the abbreviations legend.
+70 SET C1S=0
+71 SET C2S=C1S+EMMAX+5
+72 SET C3S=C2S
+73 IF PXRRMPR=0
WRITE !
+74 WRITE !,?24,"Abbreviations Used in this Report"
+75 WRITE !,?C1S,"E&M Codes"
+76 WRITE ?C2S,"Appointment Type"
+77 WRITE !,?C1S,"---------"
+78 ;W ?C2S,"------------------"
+79 ;W ?C3S,"----------------"
+80 WRITE ?C2S,"----------------"
+81 SET STOP=0
+82 SET IC=$ORDER(EMCODE(0))
+83 SET KC=$ORDER(POV(""))
+84 FOR
Begin DoDot:1
+85 IF $LENGTH(IC_KC)=0
SET STOP=1
QUIT
+86 IF '$TEST
WRITE !
+87 IF $LENGTH(IC)>0
Begin DoDot:2
+88 WRITE $PIECE(EMCODE(IC),U,2),"=",$PIECE(EMCODE(IC),U,1)
+89 SET IC=$ORDER(EMCODE(IC))
End DoDot:2
+90 IF $LENGTH(KC)>0
Begin DoDot:2
+91 WRITE ?C2S,$PIECE(POV(KC),U,2),"=",$PIECE(POV(KC),U,1)
+92 SET KC=$ORDER(POV(KC))
End DoDot:2
End DoDot:1
IF STOP
QUIT
+93 WRITE !,"___________________________________________________________________"
+94 IF PXRRMPR=1
WRITE !,"Note: Encounters with multiple providers are counted once in the totals below"
+95 ;
+96 ;Setup the final formatting parameters.
+97 SET C1HS=INDENT+3
+98 SET C1S=0
+99 SET C2HS=C1S+2
+100 SET C2S=C2HS
+101 SET C3HS=C2HS+5
+102 SET C3S=C3HS
+103 SET HEAD=1
+104 SET INDENT=0
+105 ;
+106 ;Initialize the grand totals.
+107 SET (GTCON,GTEST,GTINP,GTNEW,GTNOCPT,GTNOEM,GTOP,GTOTH,GTSSN,GTTENC)=0
+108 SET (GTCP,GTNS,GTSCH,GTTEN,GTTVIS,GTUNS)=0
+109 ;
+110 SET NOCOUNT=0
+111 SET FACILITY=0
NFAC SET FACILITY=$ORDER(^XTMP(PXRRXTMP,FACILITY))
+1 IF +FACILITY=0
GOTO DONE
+2 ;Initialize the facility totals.
+3 SET (FTCON,FTEST,FTINP,FTOTH,FTNEW,FTNOCPT,FTNOEM,FTOP,FTSSN,FTTENC)=0
+4 SET (FTCP,FTSCH,FTTEN,FTUNS)=0
+5 ;Keep track of the facilities that were found.
+6 FOR IC=1:1:NFAC
IF $PIECE(PXRRFAC(IC),U,1)=FACILITY
Begin DoDot:1
+7 SET $PIECE(PXRRFAC(IC),U,4)="M"
End DoDot:1
QUIT
+8 SET FACPNAME=$PIECE(PXRRFACN(FACILITY),U,1)_" "_$PIECE(PXRRFACN(FACILITY),U,2)
+9 ;
+10 SET STOIND="&&"
NSTO SET STOIND=$ORDER(^XTMP(PXRRXTMP,FACILITY,STOIND))
+1 IF STOIND=""
Begin DoDot:1
+2 SET FTSSN=+$GET(^XTMP(PXRRXTMP,FACILITY,"&","TOTUNIQ"))
+3 SET FTINP=+$GET(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",1))
+4 SET FTOP=+$GET(^XTMP(PXRRXTMP,FACILITY,"&","TOTINOUT",0))
+5 SET FTTVIS=+$GET(^XTMP(PXRRXTMP,FACILITY,"&","TOTVIS"))
+6 ;Subtract multiple provider encounters from facility total
+7 IF PXRRMPR=1
DO NCSUB
+8 DO WFACTOT^PXRRWLPF
+9 DO GTOTAL^PXRRWLPF
End DoDot:1
GOTO NFAC
+10 DO HEAD^PXRRWLPF(0)
+11 IF DONE
GOTO DONE
+12 IF '$DATA(PXRRPRLL)
SET PXRRPRLL=0
+13 SET LOCOPRV=" "
+14 IF BY="LOCATION"
Begin DoDot:1
+15 SET LOCOPRV=$PIECE(STOIND,U,1)_" ("_$PIECE(STOIND,U,3)_")"
+16 SET NOCOUNT=0
+17 SET INDENT=0
+18 ;If we have clinic stops split out by clinic location do not include
+19 ;the individual locations in the totals.
+20 IF (BYCLOC)&($LENGTH(STOIND,U)=4)
Begin DoDot:2
+21 SET LOCOPRV=$PIECE(STOIND,U,4)_" ("_$PIECE(STOIND,U,3)_")"
+22 SET NOCOUNT=1
+23 SET INDENT=2
End DoDot:2
End DoDot:1
+24 IF BY="PROVIDER"
Begin DoDot:1
+25 SET VACODE=$PIECE(STOIND,U,3)
+26 SET TEMP=$$ABBRV^PXRRPECU(VACODE)
+27 KILL PCL1,PCL2
+28 DO FMTPCL^PXRRPRSP(TEMP,$LENGTH($PIECE(STOIND,U,1))+1,80,.PCL1,.PCL2)
+29 SET LOCOPRV=$PIECE(STOIND,U,1)_" "_PCL1
+30 IF PXRRPRLL
SET PRVLOC=$PIECE(STOIND,U,4)_" ("_$PIECE(STOIND,U,6)_")"
End DoDot:1
+31 ;
+32 ;Write out the PCE encounter data.
+33 SET TOTCPT=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"CPT"))
+34 SET TOTENC=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTENC"))
+35 SET NOEM=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",0))
+36 IF $Y>(IOSL-BMARG-5)
DO HEAD^PXRRWLPF(1)
+37 IF DONE
GOTO DONE
+38 WRITE !!,?INDENT,LOCOPRV
+39 IF PXRRPRLL
WRITE !,?C1HS,PRVLOC
+40 IF $DATA(PCL2)
WRITE !," ",PCL2
+41 WRITE !,?C2HS,"PCE:"
+42 SET TOTEM=0
+43 ;E&M new.
+44 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(1)))
+45 WRITE ?C3S,$JUSTIFY(TEMP,6)
+46 DO NCSUM(.FTNEW,TEMP,NOCOUNT)
+47 DO NCSUM(.TOTEM,TEMP,NOCOUNT)
+48 ;E&M established.
+49 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(2)))
+50 WRITE $JUSTIFY(TEMP,6)
+51 DO NCSUM(.FTEST,TEMP,NOCOUNT)
+52 DO NCSUM(.TOTEM,TEMP,NOCOUNT)
+53 ;E&M consult.
+54 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(3)))
+55 WRITE $JUSTIFY(TEMP,6)
+56 DO NCSUM(.FTCON,TEMP,NOCOUNT)
+57 DO NCSUM(.TOTEM,TEMP,NOCOUNT)
+58 ;E&M other
+59 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"EM",EMIND(4)))
+60 WRITE $JUSTIFY(TEMP,6)
+61 DO NCSUM(.FTOTH,TEMP,NOCOUNT)
+62 DO NCSUM(.TOTEM,TEMP,NOCOUNT)
+63 WRITE $JUSTIFY(NOEM,6)
+64 DO NCSUM(.FTNOEM,NOEM,NOCOUNT)
+65 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"NOCPT"))
+66 WRITE $JUSTIFY(TEMP,6)
+67 DO NCSUM(.FTNOCPT,TEMP,NOCOUNT)
+68 WRITE $JUSTIFY(TOTENC,7)
+69 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"TOTVIS"))
+70 WRITE $JUSTIFY(TEMP,6)
+71 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"UPAT"))
+72 WRITE $JUSTIFY(TEMP,6)
+73 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",1))
+74 WRITE $JUSTIFY(TEMP,6)
+75 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"VISITS",0))
+76 WRITE $JUSTIFY(TEMP,6)
+77 ;
+78 DO NCSUM(.FTTENC,TOTENC,NOCOUNT)
+79 ;
+80 ;Write the appointment info.
+81 WRITE !,?C2HS
FOR IC=C2HS+1:1:80
WRITE "-"
+82 WRITE !,?C2HS,"SCH:"
+83 ;Purpose of Visit C&P.
+84 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(1)))
+85 WRITE ?C3S,$JUSTIFY(TEMP,6)
+86 DO NCSUM(.FTCP,TEMP,NOCOUNT)
+87 ;Purpose of Visit 10-10.
+88 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(2)))
+89 WRITE $JUSTIFY(TEMP,6)
+90 DO NCSUM(.FTTEN,TEMP,NOCOUNT)
+91 ;Purpose of Visit scheduled.
+92 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(3)))
+93 WRITE $JUSTIFY(TEMP,6)
+94 DO NCSUM(.FTSCH,TEMP,NOCOUNT)
+95 ;Purpose of Visit unscheduled.
+96 SET TEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,STOIND,"POV",POVIND(4)))
+97 WRITE $JUSTIFY(TEMP,6)
+98 DO NCSUM(.FTUNS,TEMP,NOCOUNT)
+99 ;
+100 GOTO NSTO
DONE ;
+1 IF DONE
GOTO EXIT
+2 IF $Y>(IOSL-BMARG-3)
DO PAGE^PXRRGPRT
+3 IF DONE
GOTO EXIT
+4 IF GTTENC>0
DO WGTOTAL^PXRRWLPF
+5 IF $Y>(IOSL-BMARG-3)
DO PAGE^PXRRGPRT
+6 IF DONE
GOTO EXIT
+7 DO FACNE^PXRRGPRT(INDENT)
EXIT ;
+1 ;Clean up
+2 DO EXIT^PXRRGUT
+3 DO EOR^PXRRGUT
+4 QUIT
+5 ;
+6 ;=======================================================================
NCSUM(VAR,ADD,NOCOUNT) ;No Count summation function. Only add to VAR if
+1 ; NOCOUNT is false.
+2 IF NOCOUNT
QUIT
+3 SET VAR=VAR+ADD
+4 QUIT
+5 ;
NCSUB ;Subtract multiple provider totals from facility totals
+1 ;Totals are built in PXRRWLS2,PXRRWLSE and PXRRWLSA
+2 NEW FTFLDS,FTFLD,FTEMP
+3 ;E&M codes
+4 SET EMIND(0)=0
+5 SET FTFLDS="FTNOEM;FTNEW;FTEST;FTCON;FTOTH"
+6 FOR JJ=0:1:4
Begin DoDot:1
+7 SET FTFLD=$PIECE(FTFLDS,";",JJ+1)
+8 SET FTEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,"&&","EM",EMIND(JJ)))
+9 SET @FTFLD=@FTFLD-FTEMP
End DoDot:1
+10 ;Purpose of visit codes
+11 SET FTFLDS="FTCP;FTTEN;FTSCH;FTUNS"
+12 FOR JJ=1:1:4
Begin DoDot:1
+13 SET FTFLD=$PIECE(FTFLDS,";",JJ)
+14 SET FTEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,"&&","POV",POVIND(JJ)))
+15 SET @FTFLD=@FTFLD-FTEMP
End DoDot:1
+16 ;Miscellaneous
+17 SET FTEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,"&&","TOTENC"))
+18 SET FTTENC=FTTENC-FTEMP
+19 SET FTEMP=+$GET(^XTMP(PXRRXTMP,FACILITY,"&&","NOCPT"))
+20 SET FTNOCPT=FTNOCPT-FTEMP
+21 QUIT
