source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUUD5.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PSUUD5 ;BIR/REG - UNIT DOSE PRINTER MODULE ;10 JUL 1999
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;DBIA(s)
4 ; Reference to file #40.8 supported by DBIA 2438
5 ;
6 ;PRINT CYCLE CONTROLLER FOR UNIT DOSE SUMMARY REPORT
7 ;
8EP ;Print Unit Dose Statistical Report by Drug and Summary Report
9 ;Printing Device should be opened by PSUDBQUE by new & IO set
10 ;The ^XTMP global contains print lines by drug by division
11 ;Lines 1 through 7 are page heading lines for the summary by drug by
12 ;division; The Summary Report by division only is only 6 lines
13 ;Package variables are set by calling routine prior to call.
14 NEW PSUI,PSUH,PSUL,PSUM,PSUPGS,PSUUDFLG
15 S PSUUDFLG=1 ;Flag for summary reports
16 D DT^DILF("E",PSUSDT,.EXTD)
17 S PSURP("START")=EXTD(0)
18 D DT^DILF("E",PSUEDT,.EXTD)
19 S PSURP("END")=EXTD(0)
20 U IO
21 ;
22PRTSUMS ;
23 ; Find first Division/Facility in the summary by division
24 ; then DO the PRTALL routine
25 S PSUUDSUB="PSUUD_"_PSUJOB
26 ;
27 I '$D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D PRTAMIS ;Print UD AMIS SUMMARY
28 ;
29 ; Find the first Division/Facility in the summary by drug by division
30 ; then DO the PRTDRUG routine
31 Q:PSUSMRY ; 'summary only' was selected don't print 'by drug'
32 S PSUFACN=""
33 I '$D(^XTMP(PSUUDSUB,"DRUGSUM")) D
34 .S ^XTMP("PSU_"_PSUJOB,"PSUNONE1")=""
35 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,1)="Unit Dose Statistical Data for "_PSURP("START")_" through "_PSURP("END")
36 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,2)=" "
37 .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
38 F S PSUFACN=$O(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN)) Q:PSUFACN="" D PRTDRUG
39 ;
40 ;
41 D PULL^PSUCP
42 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
43 ;Print routine for Pt. demographics summary/No data when user selects
44 ;(1)IV and (2)UD
45 I $D(PSUMOD(1))&$D(PSUMOD(2)) D
46 .I '$D(PSUMOD(4)) D
47 ..D IVSUM^PSUDEM0
48 ;
49 ;Print routine for Pt. demographics summary/No data when user selects
50 ;(2)UD only
51 I $D(PSUMOD(2))&'$D(PSUMOD(1)) D
52 .I '$D(PSUMOD(4)) D
53 ..D IVSUM^PSUDEM0
54 ;
55PRTSUMX ; EXIT PSUUD5
56 ;W @IOF
57 Q
58 ;
59PRTALL ; Print the Drug summary of all drugs by Division/Facility
60 S X=PSUFACN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
61 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
62 W @IOF
63 F I=1:1:3 W !
64 S PSUL=""
65 F S PSUL=$O(^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL)) Q:PSUL="" D
66 .S X=^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL) W !,X
67 .I PSUL=1 W " for ",PSUDIVNM,!,?72,"PAGE: 1" ; will only ever be one page
68 Q
69 ;
70PRTAMIS ;Print UD AMIS summary
71 ;
72 S PSUPGS("PG")=0
73 D PGHDR1
74 S PSUL=3
75 F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL)) Q:PSUL="" D
76 .I LNCNT+4>IOSL D PGHDR1 ; leave a margin at the bottom
77 .W !,^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL)
78 .S LNCNT=LNCNT+1
79 ;
80 Q
81 ;
82PRTDRUG ; Print the Drug summary by Drug by Division/Facility
83 ; Set page number to 0
84 S PSUPGS("PG")=0
85 S X=PSUFACN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
86 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
87 D PGHDR ; Perform 1st page heading
88 S PSUL=7 ; Report body starts at line 8
89 F S PSUL=$O(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL)) Q:PSUL="" D
90 .I $Y+4>IOSL D PGHDR ; leave a margin at the bottom
91 .W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL)
92 ;
93 Q
94 ;
95PGHDR ;Increment page number and Write Page Heading
96 ; Writes header lines 1 & 2, then page number, then lines 3 through 7
97 U IO W @IOF
98 F I=1:1:3 W !
99 W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,1) ;Print 1st line
100 W " for ",PSUDIVNM ; add division name
101 S PSUPGS("PG")=PSUPGS("PG")+1
102 W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,2),?72,"PAGE: ",PSUPGS("PG")
103 F PSUH=3:1:7 W !,$G(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUH)) ;Print next 5 lines
104 Q
105 ;
106PGHDR1 ;Page headers for AMIS summary report
107 ;
108 U IO
109 W @IOF
110 W !,^XTMP("PSU_"_PSUJOB,"UDAMIS",1)
111 W !!,?68,"Page: ",PSUPGS("PG")
112 S PSUPGS("PG")=PSUPGS("PG")+1
113 W !,$G(^XTMP("PSU_"_PSUJOB,"UDAMIS",2))
114 S LNCNT=3
115 Q
Note: See TracBrowser for help on using the repository browser.