source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOP4.m@ 862

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1PSUOP4 ;BIR/CFL - PSU PBM Outpatient Pharmacy create mailman messages ;10 JUL 1999
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA(s)
5 ; Reference to file #4.3 supported by DBIA 2496
6 ; Reference to file #59 supported by DBIA 2510
7 ; Reference to file #4 supported by DBIA 10090
8 ;
9EN ;
10 ;
11 S $P(PSUDASH,"-",100)=""
12 S $P(PSUFILL," ",100)=""
13 ;Organize index of ^XTMP("DATA") global
14 S (PSUDV,PSUTMP)=""
15 F S PSUDV=$O(^XTMP(PSUOPSUB,"DATA",PSUDV)) Q:PSUDV="" D
16 .S PSULCT=0
17 .S PSURXIEN=""
18 .F S PSURXIEN=$O(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN)) Q:PSURXIEN="" D
19 ..S PSURCT=0
20 ..F S PSURCT=$O(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT)) Q:PSURCT="" D
21 ...D DATA^PSUOP7 ;Gather data for AMIS summary report
22 ...S PSULCT=PSULCT+1
23 ...S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1)
24 ...S PSULCT=PSULCT+1
25 ...S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,2)
26 ...;S PSULCT=PSULCT+1
27 ...;S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,3)
28 ;
29 ;
30 ;Create global for Patient Demographics summary message
31 M ^XTMP("PSU_"_PSUJOB,"PSUDIVPT")=^XTMP(PSUOPSUB,"RECORDS")
32 S PSUST=0
33 F S PSUST=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST)) Q:PSUST="" D
34 .S PSUST1=0
35 .F S PSUST1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1)) Q:PSUST1="" D
36 ..I $P(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1),U,1)["*" D
37 ...K ^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1)
38 ;
39MSG ;Set up the number of lines and messages for mailman
40 ;
41 S PSUNOREC="",NONE=""
42 S PSUMSGT("M")=0,PSUMSGT("L")=0
43 I '$D(^XTMP(PSUOPSUB,"RECORDS")) D NODATA Q ;Do not go any further if there is no data to report
44 S PSUDIV=0,Z=0
45 F S PSUDIV=$O(^XTMP(PSUOPSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
46 .S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;;1
47 .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
48 .;VMP OIFO BAY PINES;ELR;PSU*3.0*31
49 .I '$L(PSUDIVNM) S X=PSUDIV D DIVNM^PSUOP6
50 .I PSUMASF!PSUDUZ!PSUPBMG D
51 ..I 'PSUSMRY D XMD,SETCNT
52 .D RECLOOP^PSUOP5,RECSUM^PSUOP5 ; send statistical summary
53 .I 'PSUSMRY D DRUGSUM^PSUOP5 ; send drug summary on condition
54 Q
55XMD ;
56 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
57 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
58 S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
59 K ^XTMP(PSUOPSUB,"XMD")
60 S PSUMC=1,PSUMLC=0
61 F PSULC=1:1 S X=$G(^XTMP(PSUOPSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
62 .S PSUMLC=PSUMLC+1
63 .I PSUMLC>PSUMAX D
64 ..I $E(X,1)="*" D
65 ...S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
66 ...K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
67 ...S PSUMC=PSUMC+1,PSUMLC=2
68 ..I $E(X,1)'="*" S PSUMC=PSUMC+1,PSUMLC=1 ; + message
69 .I $L(X)<250 S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X Q
70 .F I=250:-1:1 S Z=$E(X,I) Q:Z="^"
71 .S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
72 .S PSUMLC=PSUMLC+1
73 .S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
74 ;
75 ; Count Lines sent
76 S PSUTLC=0
77 F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUOPSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
78 ;
79 ; Transmit Messages
80VARS ; Setup variables for contents
81 F PSUM=1:1:PSUMC D
82 .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
83 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
84 .S XMSUB="V. 4.0 PBMOP "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
85 .S XMTEXT="^XTMP(PSUOPSUB,""XMD"",PSUM,"
86 .S XMCHAN=1
87 .I PSUMASF!PSUDUZ!PSUPBMG D
88 ..M XMY=PSUXMYH
89 .I 'PSUMASF M XMY=PSUXMYS1
90 .D ^XMD
91 ;
92 S:NONE PSUTLC=0
93 S PSUMSG("M")=PSUMC
94 S PSUMSG("L")=PSUTLC
95 Q
96NODATA ;Send "No data to report" message
97 S ^XTMP(PSUOPSUB,"RECORDS",PSUSNDR,1)="No data to report"
98 S NONE=1,PSUDIV=PSUSNDR
99 S ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""
100 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
101 S X=PSUDIV D DIVNM^PSUOP6
102 D XMD
103SETCNT ;Set message count and line count
104 S PSUMSGT(PSUDIV,"M")=$G(PSUMSGT(PSUDIV,"M"))+PSUMSG("M")
105 S PSUMSGT(PSUDIV,"L")=$G(PSUMSGT(PSUDIV,"L"))+PSUMSG("L")
106 S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"M")
107 S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"L")
108 Q
Note: See TracBrowser for help on using the repository browser.