source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOP6.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PSUOP6 ;BIR/REG - PSU PBM Outpatient Pharmacy Printer Output ;10 JUL 1999
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA(s)
5 ; Reference to file #59 supported by DBIA 2510
6 ;
7 ;PRINT CYCLE CONTROLLER FOR OUTPATIENT PHARMACY SUMMARY REPORT
8 ;
9EP ;
10 NEW PSUI,PSUH,PSUL,PSUM,PSUPGS
11 D DT^DILF("E",PSUSDT,.EXTD)
12 S PSURP("START")=EXTD(0)
13 D DT^DILF("E",PSUEDT,.EXTD)
14 S PSURP("END")=EXTD(0)
15 U IO
16 ;
17PRTSUMS ;
18 ; Find first Division/Facility in the summary by division
19 ; then DO the PRTALL routine
20 S PSUOPSUB="PSUOP_"_PSUJOB
21 I '$D(^XTMP(PSUOPSUB,"STATSUM")) D
22 .S ^XTMP("PSU_"_PSUJOB,"PSUNONE2")=""
23 .S ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,1)="Outpatient Statistical Data Summary for "_PSURP("START")_" through "_PSURP("END")
24 .S ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,2)=" "
25 .S ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,3)="No data to report"
26 ;
27 S PSUFACN=""
28 ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26
29 NEW PSUFIRST
30 F S PSUFACN=$O(^XTMP(PSUOPSUB,"STATSUM",PSUFACN)) Q:PSUFACN="" D PRTALL
31 ;
32 I '$D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D PRTAMIS ;Print OPAMIS SUMMARY
33 ;
34 D PULL^PSUCP
35 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
36 ;
37 ;Call Pt. Demographics summary report/No data when user selects
38 ;(1)IV and (2)UD and (4)Rx
39 ;(1)IV and (4)Rx
40 ;(2)UD and (4)Rx
41 I $D(PSUMOD(1))!$D(PSUMOD(2)) D IVSUM^PSUDEM0
42 ;
43 ;Call Pt. Demographics summary report/No data when user selects
44 ;(4)IV alone.
45 I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D IVSUM^PSUDEM0
46 ;
47 ; Find the first Division/Facility in the summary by drug by division
48 ; then DO the PRTDRUG routine
49 Q:PSUSMRY ; 'summary only' was selected don't print 'by drug'
50 S PSUFACN=""
51 I '$D(^XTMP(PSUOPSUB,"DRUGSUM")) D
52 .S ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,1)="Outpatient Statistical Data for "_PSURP("START")_" through "_PSURP("END")
53 .S ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,2)=" Page"
54 .S ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
55 F S PSUFACN=$O(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN)) Q:PSUFACN="" D PRTDRUG
56PRTSUMX ; EXIT PSUOP6
57 W @IOF
58 ;
59 Q
60 ;
61PRTALL ; Print the Drug summary of all drugs by Division/Facility
62 S X=PSUFACN,DIC=59,DIC(0)="XM" D ^DIC ;**1
63 S X=+Y S PSUDIVNM=$$VAL^PSUTL(59,X,.01)
64 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
65 I '$L(PSUDIVNM) S X=PSUFACN D DIVNM
66 ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26; REMOVE FORM FEED FIRST TIME THROUGH
67 I $G(PSUFIRST) W @IOF
68 S PSUFIRST=1
69 F I=1:1:3 W !
70 S PSUL=""
71 F S PSUL=$O(^XTMP(PSUOPSUB,"STATSUM",PSUFACN,PSUL)) Q:PSUL="" D
72 .W !,^XTMP(PSUOPSUB,"STATSUM",PSUFACN,PSUL)
73 .I PSUL=1 W " for ",PSUDIVNM,!,?72,"Page: 1" ; will only ever be one page
74 Q
75 ;
76PRTDRUG ; Print the Drug summary by Drug by Division/Facility
77 ; Set page number to 0
78 S PSUPGS("PG")=0
79 S X=PSUFACN,DIC=59,DIC(0)="XM" D ^DIC
80 S X=+Y S PSUDIVNM=$$VAL^PSUTL(59,X,.01)
81 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
82 I '$L(PSUDIVNM) S X=PSUFACN D DIVNM
83 D PGHDR ; Perform 1st page heading
84 S PSUL=6 ; Report body starts at line 7
85 F S PSUL=$O(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUL)) Q:PSUL="" D
86 .I $Y+4>IOSL D PGHDR
87 .W !,^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUL)
88 ;
89 Q
90 ;
91PRTAMIS ;Print Amis summary report
92 ;
93 U IO W @IOF
94 S PSUPGS("PG")=1
95 D PGHDR1
96 S PSUL=3
97 F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"OPAMIS",PSUL)) Q:PSUL="" D
98 .I LNCNT+4>IOSL D PGHDR1
99 .W !,^XTMP("PSU_"_PSUJOB,"OPAMIS",PSUL)
100 .S LNCNT=LNCNT+1
101 Q
102 ;
103PGHDR1 ;AMIS HEADER
104 U IO W @IOF
105 F I=1:1:3 W !
106 F I=1:1:2 W ^XTMP("PSU_"_PSUJOB,"OPAMIS",I)
107 W !!,?68,"Page: ",PSUPGS("PG")
108 S PSUPGS("PG")=PSUPGS("PG")+1
109 S LNCNT=3
110 Q
111 ;
112PGHDR ;Increment page number and Write Page Heading
113 ; Writes header lines 1 & 2, then page number, then lines 3 through 6
114 U IO W @IOF
115 F I=1:1:3 W !
116 W !,^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,1) ;Print 1st line
117 W " for ",PSUDIVNM ; add division name
118 S PSUPGS("PG")=PSUPGS("PG")+1
119 W !,$P(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,2),":",1),": ",PSUPGS("PG"),! ;Print page number
120 F PSUH=3:1:6 W !,$G(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUH)) ;Print next 5 lines
121 Q
122 ;
123DIVNM ;S PSUDIVNM FROM FILE 40.8 IF NOT IN FILE 59
124 S DIC=40.8,DIC(0)="X",D="C" D IX^DIC
125 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
126 Q
Note: See TracBrowser for help on using the repository browser.