PXRRWLPF ;ISL/PKR - Printing functions for the encounter summary report. ;8/26/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**20**;Aug 12, 1996
;
;=======================================================================
GTOTAL ;Add the facility totals to the grand totals.
S GTCON=GTCON+FTCON
S GTEST=GTEST+FTEST
S GTINP=GTINP+FTINP
S GTNEW=GTNEW+FTNEW
S GTNOEM=GTNOEM+FTNOEM
S GTNOCPT=GTNOCPT+FTNOCPT
S GTOP=GTOP+FTOP
S GTOTH=GTOTH+FTOTH
S GTSSN=GTSSN+FTSSN
S GTTENC=GTTENC+FTTENC
S GTTVIS=GTTVIS+FTTVIS
S GTCP=GTCP+FTCP
S GTSCH=GTSCH+FTSCH
S GTTEN=GTTEN+FTTEN
S GTUNS=GTUNS+FTUNS
Q
;
;=======================================================================
HEAD(NEWPAGE) ;If necessary, write the header.
I NEWPAGE D PAGE
E I $Y>(IOSL-BMARG) D PAGE
I DONE Q
I HEAD D
. N IC
. I $Y>(IOSL-BMARG-7) D PAGE^PXRRGPRT
. I DONE G NP
. W !!,"Facility: ",FACPNAME
. W !,?C1HS,BY
. W !,?C3HS," E&M CATEGORIES NON NO TOT TOT UNIQ IN OUT"
. W !,?C2HS,"PCE:",?C3HS," NEW EST CON OTH E&M CPT ENC VIS SSN PAT PAT"
. D WDIVIDER(C2HS)
. W !,?C2HS,"SCH:",?C3HS," C&P 10-10 SCH UNS"
. W ! F IC=1:1:80 W "="
NP . S HEAD=0
Q
;
;=======================================================================
PAGE ;form feed to new page
I ($E(IOST)="C")&(IO=IO(0)) D
. S DIR(0)="E"
. W !
. D ^DIR K DIR
I $D(DIROUT)!$D(DUOUT)!($D(DTOUT)) S DONE=1 Q
W:$D(IOF) @IOF
S PAGE=PAGE+1
D HDR^PXRRGPRT(PAGE)
S HEAD=1
Q
;
;=======================================================================
RETSOC(FILE,FIELD,SOC) ;Return the set of codes for field FIELD of
;file FILE in SOC.
N CODE,IC,TEMP,TSOC
D HELP^DIE(FILE,"",FIELD,"S","TSOC")
;TSOC will have the code followed by a number of spaces and then
;the code text.
F IC=2:1:TSOC("DIHELP") D
. S TEMP=TSOC("DIHELP",IC)
. S CODE=$P(TEMP," ",1)
. S $P(TEMP," ",1)=CODE_U
. S TEMP=$$STRREP^PXRRUTIL(TEMP," ","")
. S SOC(CODE)=$P(TEMP,U,2)
Q
;
;=======================================================================
WDIVIDER(START) ;Write the header divider.
N IC
W !,?START F IC=START+1:1:80 W "-"
Q
;
;=======================================================================
WFACTOT ;Write the facility totals.
I $Y>(IOSL-BMARG-5) D HEAD(1)
W !!,?C1HS,FACPNAME," (totals)"
W !,?C2HS,"PCE:"
W ?C3S
W $J(FTNEW,6)
W $J(FTEST,6)
W $J(FTCON,6)
W $J(FTOTH,6)
W $J(FTNOEM,6)
W $J(FTNOCPT,6)
W $J(FTTENC,7)
W $J(FTTVIS,6)
W $J(FTSSN,6)
W $J(FTINP,6)
W $J(FTOP,6)
;
;Write the appointment info.
D WDIVIDER(C2HS)
W !,?C2HS,"SCH:"
W ?C3HS,$J(FTCP,6)
W $J(FTTEN,6)
W $J(FTSCH,6)
W $J(FTUNS,6)
Q
;
;=======================================================================
WGTOTAL ;Write the grand totals.
I $Y>(IOSL-BMARG-5) D HEAD(1)
W !!,?C1HS,"GRAND TOTALS"
W !,?C2HS,"PCE:"
W ?C3S
W $J(GTNEW,6)
W $J(GTEST,6)
W $J(GTCON,6)
W $J(GTOTH,6)
W $J(GTNOEM,6)
W $J(GTNOCPT,6)
W $J(GTTENC,7)
W $J(GTTVIS,6)
W $J(GTSSN,6)
W $J(GTINP,6)
W $J(GTOP,6)
;
;Write the appointment info.
D WDIVIDER(C2HS)
W !,?C2HS,"SCH:"
W ?C3HS,$J(GTCP,6)
W $J(GTTEN,6)
W $J(GTSCH,6)
W $J(GTUNS,6)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRWLPF 3266 printed Dec 13, 2024@02:31:17 Page 2
PXRRWLPF ;ISL/PKR - Printing functions for the encounter summary report. ;8/26/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20**;Aug 12, 1996
+2 ;
+3 ;=======================================================================
GTOTAL ;Add the facility totals to the grand totals.
+1 SET GTCON=GTCON+FTCON
+2 SET GTEST=GTEST+FTEST
+3 SET GTINP=GTINP+FTINP
+4 SET GTNEW=GTNEW+FTNEW
+5 SET GTNOEM=GTNOEM+FTNOEM
+6 SET GTNOCPT=GTNOCPT+FTNOCPT
+7 SET GTOP=GTOP+FTOP
+8 SET GTOTH=GTOTH+FTOTH
+9 SET GTSSN=GTSSN+FTSSN
+10 SET GTTENC=GTTENC+FTTENC
+11 SET GTTVIS=GTTVIS+FTTVIS
+12 SET GTCP=GTCP+FTCP
+13 SET GTSCH=GTSCH+FTSCH
+14 SET GTTEN=GTTEN+FTTEN
+15 SET GTUNS=GTUNS+FTUNS
+16 QUIT
+17 ;
+18 ;=======================================================================
HEAD(NEWPAGE) ;If necessary, write the header.
+1 IF NEWPAGE
DO PAGE
+2 IF '$TEST
IF $Y>(IOSL-BMARG)
DO PAGE
+3 IF DONE
QUIT
+4 IF HEAD
Begin DoDot:1
+5 NEW IC
+6 IF $Y>(IOSL-BMARG-7)
DO PAGE^PXRRGPRT
+7 IF DONE
GOTO NP
+8 WRITE !!,"Facility: ",FACPNAME
+9 WRITE !,?C1HS,BY
+10 WRITE !,?C3HS," E&M CATEGORIES NON NO TOT TOT UNIQ IN OUT"
+11 WRITE !,?C2HS,"PCE:",?C3HS," NEW EST CON OTH E&M CPT ENC VIS SSN PAT PAT"
+12 DO WDIVIDER(C2HS)
+13 WRITE !,?C2HS,"SCH:",?C3HS," C&P 10-10 SCH UNS"
+14 WRITE !
FOR IC=1:1:80
WRITE "="
NP SET HEAD=0
End DoDot:1
+1 QUIT
+2 ;
+3 ;=======================================================================
PAGE ;form feed to new page
+1 IF ($EXTRACT(IOST)="C")&(IO=IO(0))
Begin DoDot:1
+2 SET DIR(0)="E"
+3 WRITE !
+4 DO ^DIR
KILL DIR
End DoDot:1
+5 IF $DATA(DIROUT)!$DATA(DUOUT)!($DATA(DTOUT))
SET DONE=1
QUIT
+6 if $DATA(IOF)
WRITE @IOF
+7 SET PAGE=PAGE+1
+8 DO HDR^PXRRGPRT(PAGE)
+9 SET HEAD=1
+10 QUIT
+11 ;
+12 ;=======================================================================
RETSOC(FILE,FIELD,SOC) ;Return the set of codes for field FIELD of
+1 ;file FILE in SOC.
+2 NEW CODE,IC,TEMP,TSOC
+3 DO HELP^DIE(FILE,"",FIELD,"S","TSOC")
+4 ;TSOC will have the code followed by a number of spaces and then
+5 ;the code text.
+6 FOR IC=2:1:TSOC("DIHELP")
Begin DoDot:1
+7 SET TEMP=TSOC("DIHELP",IC)
+8 SET CODE=$PIECE(TEMP," ",1)
+9 SET $PIECE(TEMP," ",1)=CODE_U
+10 SET TEMP=$$STRREP^PXRRUTIL(TEMP," ","")
+11 SET SOC(CODE)=$PIECE(TEMP,U,2)
End DoDot:1
+12 QUIT
+13 ;
+14 ;=======================================================================
WDIVIDER(START) ;Write the header divider.
+1 NEW IC
+2 WRITE !,?START
FOR IC=START+1:1:80
WRITE "-"
+3 QUIT
+4 ;
+5 ;=======================================================================
WFACTOT ;Write the facility totals.
+1 IF $Y>(IOSL-BMARG-5)
DO HEAD(1)
+2 WRITE !!,?C1HS,FACPNAME," (totals)"
+3 WRITE !,?C2HS,"PCE:"
+4 WRITE ?C3S
+5 WRITE $JUSTIFY(FTNEW,6)
+6 WRITE $JUSTIFY(FTEST,6)
+7 WRITE $JUSTIFY(FTCON,6)
+8 WRITE $JUSTIFY(FTOTH,6)
+9 WRITE $JUSTIFY(FTNOEM,6)
+10 WRITE $JUSTIFY(FTNOCPT,6)
+11 WRITE $JUSTIFY(FTTENC,7)
+12 WRITE $JUSTIFY(FTTVIS,6)
+13 WRITE $JUSTIFY(FTSSN,6)
+14 WRITE $JUSTIFY(FTINP,6)
+15 WRITE $JUSTIFY(FTOP,6)
+16 ;
+17 ;Write the appointment info.
+18 DO WDIVIDER(C2HS)
+19 WRITE !,?C2HS,"SCH:"
+20 WRITE ?C3HS,$JUSTIFY(FTCP,6)
+21 WRITE $JUSTIFY(FTTEN,6)
+22 WRITE $JUSTIFY(FTSCH,6)
+23 WRITE $JUSTIFY(FTUNS,6)
+24 QUIT
+25 ;
+26 ;=======================================================================
WGTOTAL ;Write the grand totals.
+1 IF $Y>(IOSL-BMARG-5)
DO HEAD(1)
+2 WRITE !!,?C1HS,"GRAND TOTALS"
+3 WRITE !,?C2HS,"PCE:"
+4 WRITE ?C3S
+5 WRITE $JUSTIFY(GTNEW,6)
+6 WRITE $JUSTIFY(GTEST,6)
+7 WRITE $JUSTIFY(GTCON,6)
+8 WRITE $JUSTIFY(GTOTH,6)
+9 WRITE $JUSTIFY(GTNOEM,6)
+10 WRITE $JUSTIFY(GTNOCPT,6)
+11 WRITE $JUSTIFY(GTTENC,7)
+12 WRITE $JUSTIFY(GTTVIS,6)
+13 WRITE $JUSTIFY(GTSSN,6)
+14 WRITE $JUSTIFY(GTINP,6)
+15 WRITE $JUSTIFY(GTOP,6)
+16 ;
+17 ;Write the appointment info.
+18 DO WDIVIDER(C2HS)
+19 WRITE !,?C2HS,"SCH:"
+20 WRITE ?C3HS,$JUSTIFY(GTCP,6)
+21 WRITE $JUSTIFY(GTTEN,6)
+22 WRITE $JUSTIFY(GTSCH,6)
+23 WRITE $JUSTIFY(GTUNS,6)
+24 QUIT
+25 ;
