source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRWLPF.m@ 808

Last change on this file since 808 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1PXRRWLPF ;ISL/PKR - Printing functions for the encounter summary report. ;8/26/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20**;Aug 12, 1996
3 ;
4 ;=======================================================================
5GTOTAL ;Add the facility totals to the grand totals.
6 S GTCON=GTCON+FTCON
7 S GTEST=GTEST+FTEST
8 S GTINP=GTINP+FTINP
9 S GTNEW=GTNEW+FTNEW
10 S GTNOEM=GTNOEM+FTNOEM
11 S GTNOCPT=GTNOCPT+FTNOCPT
12 S GTOP=GTOP+FTOP
13 S GTOTH=GTOTH+FTOTH
14 S GTSSN=GTSSN+FTSSN
15 S GTTENC=GTTENC+FTTENC
16 S GTTVIS=GTTVIS+FTTVIS
17 S GTCP=GTCP+FTCP
18 S GTSCH=GTSCH+FTSCH
19 S GTTEN=GTTEN+FTTEN
20 S GTUNS=GTUNS+FTUNS
21 Q
22 ;
23 ;=======================================================================
24HEAD(NEWPAGE) ;If necessary, write the header.
25 I NEWPAGE D PAGE
26 E I $Y>(IOSL-BMARG) D PAGE
27 I DONE Q
28 I HEAD D
29 . N IC
30 . I $Y>(IOSL-BMARG-7) D PAGE^PXRRGPRT
31 . I DONE G NP
32 . W !!,"Facility: ",FACPNAME
33 . W !,?C1HS,BY
34 . W !,?C3HS," E&M CATEGORIES NON NO TOT TOT UNIQ IN OUT"
35 . W !,?C2HS,"PCE:",?C3HS," NEW EST CON OTH E&M CPT ENC VIS SSN PAT PAT"
36 . D WDIVIDER(C2HS)
37 . W !,?C2HS,"SCH:",?C3HS," C&P 10-10 SCH UNS"
38 . W ! F IC=1:1:80 W "="
39NP . S HEAD=0
40 Q
41 ;
42 ;=======================================================================
43PAGE ;form feed to new page
44 I ($E(IOST)="C")&(IO=IO(0)) D
45 . S DIR(0)="E"
46 . W !
47 . D ^DIR K DIR
48 I $D(DIROUT)!$D(DUOUT)!($D(DTOUT)) S DONE=1 Q
49 W:$D(IOF) @IOF
50 S PAGE=PAGE+1
51 D HDR^PXRRGPRT(PAGE)
52 S HEAD=1
53 Q
54 ;
55 ;=======================================================================
56RETSOC(FILE,FIELD,SOC) ;Return the set of codes for field FIELD of
57 ;file FILE in SOC.
58 N CODE,IC,TEMP,TSOC
59 D HELP^DIE(FILE,"",FIELD,"S","TSOC")
60 ;TSOC will have the code followed by a number of spaces and then
61 ;the code text.
62 F IC=2:1:TSOC("DIHELP") D
63 . S TEMP=TSOC("DIHELP",IC)
64 . S CODE=$P(TEMP," ",1)
65 . S $P(TEMP," ",1)=CODE_U
66 . S TEMP=$$STRREP^PXRRUTIL(TEMP," ","")
67 . S SOC(CODE)=$P(TEMP,U,2)
68 Q
69 ;
70 ;=======================================================================
71WDIVIDER(START) ;Write the header divider.
72 N IC
73 W !,?START F IC=START+1:1:80 W "-"
74 Q
75 ;
76 ;=======================================================================
77WFACTOT ;Write the facility totals.
78 I $Y>(IOSL-BMARG-5) D HEAD(1)
79 W !!,?C1HS,FACPNAME," (totals)"
80 W !,?C2HS,"PCE:"
81 W ?C3S
82 W $J(FTNEW,6)
83 W $J(FTEST,6)
84 W $J(FTCON,6)
85 W $J(FTOTH,6)
86 W $J(FTNOEM,6)
87 W $J(FTNOCPT,6)
88 W $J(FTTENC,7)
89 W $J(FTTVIS,6)
90 W $J(FTSSN,6)
91 W $J(FTINP,6)
92 W $J(FTOP,6)
93 ;
94 ;Write the appointment info.
95 D WDIVIDER(C2HS)
96 W !,?C2HS,"SCH:"
97 W ?C3HS,$J(FTCP,6)
98 W $J(FTTEN,6)
99 W $J(FTSCH,6)
100 W $J(FTUNS,6)
101 Q
102 ;
103 ;=======================================================================
104WGTOTAL ;Write the grand totals.
105 I $Y>(IOSL-BMARG-5) D HEAD(1)
106 W !!,?C1HS,"GRAND TOTALS"
107 W !,?C2HS,"PCE:"
108 W ?C3S
109 W $J(GTNEW,6)
110 W $J(GTEST,6)
111 W $J(GTCON,6)
112 W $J(GTOTH,6)
113 W $J(GTNOEM,6)
114 W $J(GTNOCPT,6)
115 W $J(GTTENC,7)
116 W $J(GTTVIS,6)
117 W $J(GTSSN,6)
118 W $J(GTINP,6)
119 W $J(GTOP,6)
120 ;
121 ;Write the appointment info.
122 D WDIVIDER(C2HS)
123 W !,?C2HS,"SCH:"
124 W ?C3HS,$J(GTCP,6)
125 W $J(GTTEN,6)
126 W $J(GTSCH,6)
127 W $J(GTUNS,6)
128 Q
129 ;
Note: See TracBrowser for help on using the repository browser.