source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUPR5.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: 4.6 KB
Line 
1PSUPR5 ;BIR/PDW - PROCUREMENT EXTRACT SUMMARY MESSAGE GENERATOR ;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 ;
6EN ;EP generate Total & Cost summary
7 ;
8EN1 N PSUITT,PSUREC,PSUTC
9 ;PSUITT - TOTAL ITEMS
10 ;PSUTC - TOTAL COST
11 S:'$D(PSUPRJOB) PSUPRJOB=PSUJOB
12 S:'$D(PSUPRSUB) PSUPRSUB="PSUPR_"_PSUPRJOB
13 ;
14 I '$D(^XTMP(PSUPRSUB,"RECORDS")) G NODATA
15DIV ;EP Loop by Division
16 S PSUDIV="" F S PSUDIV=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MESSAGE
17 Q
18 ;
19MESSAGE ;EP Generate Summary Messages for a Division
20 ;
21 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
22 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
23MSG1 ; Generate 1st summary message
24 ;
25 S PSUITT=0,PSUTC=0
26 ;
27 ; loop to get totals from records stored
28 S PSUREC=0
29 K ^TMP($J,"PSUITNM") ;
30 F S PSUREC=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSUREC)) Q:PSUREC'>0 S X=^(PSUREC),PSUTC=PSUTC+$P(X,U,19) S PSUIT=$P(X,U,8) S:PSUIT="" PSUIT=$P(X,U,7) S:PSUIT'="" ^TMP($J,"PSUITNM",PSUIT)=""
31 ; get number of unique items stored in PSUITNM
32 S X="" F PSUITT=0:1 S X=$O(^TMP($J,"PSUITNM",X)) Q:X=""
33 K ^TMP($J,"PSUITNM")
34 S XMDUZ=DUZ
35 M XMY=PSUXMYS1
36 ;
37 S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
38 S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
39 N PSUMSG
40 S PSUMSG(1)=" Procurement Statistical Summary"
41 S PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
42 S PSUMSG(3)=" "
43 S PSUMSG(4)="Total of Drug/Supply Items: "_PSUITT
44 S PSUMSG(5)="Total Cost: $ "_PSUTC
45 S PSUMSG(6)=" "
46 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
47 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
48 S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
49 Q:PSUDIV=0 ;Eliminate empty CoreFLS messages
50 S XMTEXT="PSUMSG("
51 S XMCHAN=1
52 M ^XTMP(PSUPRSUB,"REPORT1",PSUDIV)=PSUMSG
53 D ^XMD
54 K PSUMSG
55 ;
56MSG2 ; SUMMARY BY DRUG
57 ; loop records stored
58 ; psunm - name, psudisp - disp unit, psutq - total quantity, psutc - total cost
59 S PSUREC=0,PSUDRNM=""
60 K ^XTMP(PSUPRSUB,"DRUG")
61 F S PSUREC=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSUREC)) Q:PSUREC'>0 S X=^(PSUREC) D
62 . S PSUNM=$P(X,U,8),PSUTQ=$P(X,U,17),PSUTC=$P(X,U,19),PSUDISP=$P(X,U,12)
63 . S:PSUNM="" PSUNM=$P(X,U,7)
64 . S PSUNM=$E(PSUNM,1,30)
65 . I '$L(PSUNM) Q
66 . S ^XTMP(PSUPRSUB,"DRUG",PSUNM)=""
67 . S ^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ")=$G(^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ"))+PSUTQ
68 . S ^XTMP(PSUPRSUB,"DRUG",PSUNM,"TC")=$G(^XTMP(PSUPRSUB,"DRUG",PSUNM,"TC"))+PSUTC
69 . S ^XTMP(PSUPRSUB,"DRUG",PSUNM,"DISP")=PSUDISP
70 ;
71 ;
72 S PSUG="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV)"
73 K @PSUG
74 S @PSUG@(1)=" Procurement Data Summary"
75 S @PSUG@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
76 S @PSUG@(3)=" "
77 S X="",X=$$SETSTR^VALM1("Dispense",X,53,8),X=$$SETSTR^VALM1("Total",X,63,5),X=$$SETSTR^VALM1("Total",X,73,5)
78 S @PSUG@(4)=X
79 S X="Drug/Supply Name",X=$$SETSTR^VALM1("Unit",X,53,4),X=$$SETSTR^VALM1("Qty",X,63,3),X=$$SETSTR^VALM1("Cost",X,73,4)
80 S @PSUG@(5)=X
81 S X="",$P(X,"-",79)=""
82 S @PSUG@(6)=X
83 S PSULC=6
84 N PSUNM,PSUDISP,PSUTQ,PSUTC,PSUTQT,PSUTCT
85 S (PSUTQT,PSUDISP,PSUTQ,PSUTC,PSUTCT)=0
86 ; loop drug names
87 S PSUNM=""
88 F S PSUNM=$O(^XTMP(PSUPRSUB,"DRUG",PSUNM)) Q:PSUNM="" S PSUTQ=^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ"),PSUTC=^("TC"),PSUDISP=^("DISP") D
89 . S PSULC=PSULC+1
90 . S PSUTQT=$G(PSUTQT)+PSUTQ,PSUTCT=$G(PSUTCT)+PSUTC
91 . S X=$E(PSUNM,1,50)
92 . S X=$$SETSTR^VALM1(PSUDISP,X,53,$L(PSUDISP))
93 . S X=$$SETSTR^VALM1($J(PSUTQ,6,0),X,62,6)
94 . S X=$$SETSTR^VALM1($J(PSUTC,8,2),X,70,8)
95 . S @PSUG@(PSULC)=X
96 ;
97 S X="",$P(X,"-",79)=""
98 S PSULC=PSULC+1
99 S @PSUG@(PSULC)=X
100 S X="Total",X=$$SETSTR^VALM1($J(PSUTQT,6,0),X,62,6),X=$$SETSTR^VALM1($J(PSUTCT,8,2),X,70,8)
101 S PSULC=PSULC+1
102 S @PSUG@(PSULC)=X
103 S @PSUG@(PSULC+1)=" "
104 S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
105 S XMTEXT="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV,"
106 S XMCHAN=1
107 M XMY=PSUXMYS2
108 I '$G(PSUSMRY) D ^XMD
109 Q
110NODATA ;EP SEND NO DATA MESSAGE
111 S XMDUZ=DUZ
112 M XMY=PSUXMYS1
113 ;
114 S PSUDIV=PSUSNDR
115 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
116 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
117 S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
118 S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
119 S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
120 S XMTEXT="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV,"
121 S XMCHAN=1
122 K X
123 S X(1)=" Procurement Statistical Summary"
124 S X(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
125 S X(3)=" "
126 S X(4)="No data to report"
127 S X(5)=" "
128 M ^XTMP(PSUPRSUB,"REPORT1",PSUDIV)=X
129 S XMTEXT="X("
130 S:$G(PSUDUZ) XMY(PSUDUZ)=""
131 D ^XMD
132 S X(1)=" Procurement Data Summary"
133 M ^XTMP(PSUPRSUB,"REPORT2",PSUDIV)=X ;store for print cycle
134 Q
Note: See TracBrowser for help on using the repository browser.