source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM0.m@ 1000

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1PSUDEM0 ;BIR/DAM - Patient Demographics Summary Print Routine ; 20 DEC 2001
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;
5PRINT ;Print header for pt demographics
6 Q
7 ;
8OPV ;EN Outpatient Visit "No Data" message. Called only when
9 ; user answers 'yes'
10 ;to "Do you want to receive this in a MailMan message?" AND when there
11 ;is no data to report.
12 ;
13 Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
14 Q:PSUSMRY ;Don't print if user wants summary only
15 Q:$D(^XTMP("PSU_"_PSUJOB,"PSUOPV"))
16 ;
17 W @IOF
18 D DT^DILF("E",PSUSDT,.EXTD)
19 S PSURP("START")=EXTD(0)
20 D DT^DILF("E",PSUEDT,.EXTD)
21 S PSURP("END")=EXTD(0)
22 ;
23 S PSUOVSUB="PSUOPV_"_PSUJOB
24 S ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,1)="Outpatient Visits for "_PSURP("START")_" through "_PSURP("END")
25 S ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,2)=" "
26 S ^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,3)="No data to report"
27 ;
28 U IO
29 ;
30 ;F I=1:1:3 W !
31 S PSUL=0
32 F S PSUL=$O(^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,PSUL)) Q:PSUL="" D
33 .S X=^XTMP(PSUOVSUB,"PSUOPV",PSUSNDR,PSUL) W !,X
34 .I PSUL=1 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?72,"PAGE: 1"
35 ;
36 Q
37 ;
38PTF ;EN Inpatient Visit "No Data" message.
39 ;Called only when user answers 'YES'
40 ;to "Do you want to receive this in a MailMan message?" AND when there
41 ;is no data to report.
42 ;
43 Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
44 Q:PSUSMRY ;Don't print if user wants summary only
45 Q:$D(^XTMP("PSU_"_PSUJOB,"PSUIPV"))
46 ;
47 W @IOF
48 D DT^DILF("E",PSUSDT,.EXTD)
49 S PSURP("START")=EXTD(0)
50 D DT^DILF("E",PSUEDT,.EXTD)
51 S PSURP("END")=EXTD(0)
52 ;
53 S PSUIVSUB="PSUIPV_"_PSUJOB
54 S ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,1)="Inpatient PTF Records for "_PSURP("START")_" through "_PSURP("END")
55 S ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,2)=" "
56 S ^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,3)="No data to report"
57 ;
58 U IO
59 ;
60 ;F I=1:1:3 W !
61 S PSUL=0
62 F S PSUL=$O(^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,PSUL)) Q:PSUL="" D
63 .S X=^XTMP(PSUIVSUB,"PSUIPV",PSUSNDR,PSUL) W !,X
64 .I PSUL=1 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?72,"PAGE: 1"
65 ;
66 Q
67 ;
68PRO ;EN Provider information print routine. Prints summary report.
69 ;Called only when user answers 'NO'
70 ;to "Do you want to receive this in a MailMan message?"
71 ;
72 D DT^DILF("E",PSUSDT,.EXTD)
73 S PSURP("START")=EXTD(0)
74 D DT^DILF("E",PSUEDT,.EXTD)
75 S PSURP("END")=EXTD(0)
76 ;
77 S PSUPGS("PG")=1
78 ;
79 S PSUPROSB="PSUPRO_"_PSUJOB
80 D PGHDR
81 ;
82 S N=0,K=3
83 F S N=$O(^XTMP("PSU_"_PSUJOB,"PSUSUM",N)) Q:N="" D
84 .M ^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,K)=^XTMP("PSU_"_PSUJOB,"PSUSUM",N)
85 .S K=K+1 ;Set Provider summary into XTMP global
86 ;
87 ;
88 S PSUL=0
89 F S PSUL=$O(^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUL)) Q:PSUL="" D
90 .I LNCNT+4>IOSL D PGHDR
91 .S X=^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUL) W !,X
92 .S LNCNT=LNCNT+1
93 ;
94 K ^XTMP("PSU_"_PSUJOB,"PSUSUM")
95 Q
96 ;
97PGHDR ;Page header for Provider summary message
98 ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26 REMOVE FORM FEED
99 ;U IO W @IOF
100 W "Provider Data for "_PSURP("START")_" through "_PSURP("END")_" for "_$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
101 W !,?68,"PAGE: "_PSUPGS("PG")
102 S PSUPGS("PG")=PSUPGS("PG")+1
103 F PSUH=9:1:12 W !,$G(^XTMP(PSUPROSB,"PSUPRO",PSUSNDR,PSUH))
104 S LNCNT=5
105 Q
106 ;
107IVSUM ;EN Print routine for all Pt. Demographics Summary reports.
108 ;Prints NO Data
109 ;and Summary report to screen if user answers 'N' to "Do you want a
110 ;copy of this message sent to you in mailman?"
111 ;
112 D INST^PSUDEM1
113 D COMM
114 U IO
115 W @IOF
116 ;
117 S PSUIVSUB="PSUPD_"_PSUJOB
118 S ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,1)="Patient Demographics Summary for "_PSURP("START")_" through "_PSURP("END")
119 S ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,2)=" "
120 ;
121 ;Do the following if there is no data to report
122 I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE")) D Q
123 .S ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,3)="No data to report"
124 .S PSUL=0
125 .F S PSUL=$O(^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL)) Q:PSUL="" D
126 ..S X=^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL) W !,X
127 ..I PSUL=2 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?69,"Page: 1"
128 ;
129 ;Do the following if there is data to report in a summary
130 S N=0,K=3
131 F S N=$O(^XTMP("PSU_"_PSUJOB,"PSUSUMA",N)) Q:N="" D
132 .M ^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,K)=^XTMP("PSU_"_PSUJOB,"PSUSUMA",N)
133 .S K=K+1 ;Set Provider summary into XTMP global
134 ;
135 ;
136 S PSUL=0
137 F S PSUL=$O(^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL)) Q:PSUL="" D
138 .S X=^XTMP(PSUIVSUB,"PSUPD",PSUSNDR,PSUL) W !,X
139 .I PSUL=2 W " for ",$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2),!,?69,"Page: 1"
140 ;
141 Q
142 ;
143COMM ;Common variables among all print subroutines
144 ;
145 D DT^DILF("E",PSUSDT,.EXTD)
146 S PSURP("START")=EXTD(0)
147 D DT^DILF("E",PSUEDT,.EXTD)
148 S PSURP("END")=EXTD(0)
149 ;
150 Q
Note: See TracBrowser for help on using the repository browser.