source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUAR4.m@ 1456

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1PSUAR4 ;BIR/PDW - AR/WS SUMMARY MAILMESSAGES ;25 SEP 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;DBIAs
4 ; Reference to file #40.8 supported by DBIA 2438
5 ; Reference to file #50 supported by DBIA 221
6 ;
7EN ;EP Generate mail message summaries
8 ; also store image for printed reports
9 ;
10 D DRUGSUM
11 ;
12 Q
13 ;
14DRUGSUM ;EP Generate Drug Summary Message(s) by DIV
15 ; ^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)=Total Dispenses ;from PSUAR2
16 S PSUDIV=0
17 F S PSUDIV=$O(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)) Q:PSUDIV="" D DRUGXMD
18 Q
19 ;
20DRUGXMD ;EP Generate Mail Message with PSUDIV provided
21 ; Assemble top of message
22 ; Find Division Name
23 I '$D(^XTMP(PSUARSUB,"DIV_DRUG")) Q
24 ;
25 K DIC
26 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
27 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
28 S XMSUB="V. 4.0 PBMAR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
29 M XMY=PSUXMYS2
30 S XMDUZ=DUZ
31 S XMTEXT="PSUMSG("
32 S XMCHAN=1
33 S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
34 S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
35 N PSUMSG
36 S PSUMSG(1)=" Automatic Replenishment/Ward Stock Data Summary"
37 S PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
38 S PSUMSG(3)=" "
39 S X=""
40 S X=$$SETSTR^VALM1("Total",X,40,5)
41 S X=$$SETSTR^VALM1("Total",X,52,5)
42 S PSUMSG(4)=X
43 S X="",X=$$SETSTR^VALM1("Dispensed",X,40,9),X=$$SETSTR^VALM1("Dispensed",X,52,9),X=$$SETSTR^VALM1("AMIS",X,64,4)
44 S PSUMSG(5)=X
45 S X="DRUG NAME",X=$$SETSTR^VALM1("Units",X,40,5),X=$$SETSTR^VALM1("Cost",X,52,4),X=$$SETSTR^VALM1("Category",X,64,8)
46 S PSUMSG(6)=X
47 S X="",$P(X,"-",79)=""
48 S PSUMSG(7)=X
49 ;
50 ; Drug Data: Move into local array ^TMP($J,"PSUDRUG",da)=Total dispenses
51 K ^TMP($J,"PSUDRUG")
52 M ^TMP($J,"PSUDRUG")=^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)
53 ;
54 ; alphabetize the list of drugs into PSUDRNM()=PSUDRDA
55 K ^TMP($J,"PSUDRNM")
56 S PSUDRDA=0 F S PSUDRDA=$O(^TMP($J,"PSUDRUG",PSUDRDA)) Q:'PSUDRDA S ^TMP($J,"PSUDRNM",$$VAL^PSUTL(50,PSUDRDA,.01))=PSUDRDA
57 ;
58 ; Build the drug lines of the message
59 S PSUNM="",PSUTDISP=0,PSUCOSTT=0
60 F PSULC=8:1 S PSUNM=$O(^TMP($J,"PSUDRNM",PSUNM)) Q:PSUNM="" D
61 . S PSUDRDA=^TMP($J,"PSUDRNM",PSUNM)
62 . ; retrieve drug details
63 . K PSUD,PSUCAT
64 . M PSUD=^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)
65 . S PSUDISP=^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV,PSUDRDA)
66 . S PSUCOST=PSUD(16)
67 . S PSUTCOST=PSUDISP*PSUCOST*100\1/100
68 . S PSUNFI=PSUD(99999.17),PSUNFI=$S(PSUNFI="":" ",PSUNFI=1:"",1:"#")
69 . S PSUNONF=PSUD(51),PSUNONF=$S(PSUNONF:"*",1:" ")
70 . S PSUNMT=$E(PSUNM,1,35)_PSUNONF_PSUNFI
71 . S PSUCAT=PSUD(301)
72 . S X=PSUNMT
73 . S X=$$SETSTR^VALM1($J(PSUDISP,8,2),X,40,8)
74 . S X=$$SETSTR^VALM1($J(PSUTCOST,8,2),X,52,8)
75 . S X=$$SETSTR^VALM1(PSUCAT,X,64,$L(PSUCAT))
76 . S PSUMSG(PSULC)=X
77 . S PSUTDISP=PSUTDISP+PSUDISP,PSUCOSTT=PSUCOSTT+PSUTCOST
78 ;
79 S X=""
80 S $P(X,"-",79)=""
81 S PSUMSG(PSULC)=X
82 S X="TOTALS",X=$$SETSTR^VALM1($J(PSUTDISP,8,2),X,40,8),X=$$SETSTR^VALM1($J(PSUCOSTT,8,2),X,52,8)
83 S PSUMSG(PSULC+1)=X
84 S PSUMSG(PSULC+2)=" "
85 S PSUMSG(PSULC+3)="* Non-Formulary"
86 S PSUMSG(PSULC+4)="# Not on National Formulary"
87 S PSUMSG(PSULC+5)=" "
88 ;
89 I '$G(PSUSMRY) D ^XMD
90 M ^XTMP(PSUARSUB,"REPORT2",PSUDIV)=PSUMSG
91 Q
Note: See TracBrowser for help on using the repository browser.