source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOPMD.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1PSUOPMD ;BIR/CFL,DAM - PSU PBM Multidose Outpatient Pharmacy create mailman messages ;17 NOV 2004
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("DATAMD") global
14 S (PSUDV,PSUTMP)=""
15 F S PSUDV=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV)) Q:PSUDV="" D
16 .S PSULCT=0
17 .S PSURXIEN=""
18 .F S PSURXIEN=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN)) Q:PSURXIEN="" D
19 ..S PSURCT=0
20 ..F S PSURCT=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT)) Q:PSURCT="" D
21 ...S PSULCT=PSULCT+1
22 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,1)
23 ...S PSULCT=PSULCT+1
24 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,2)
25 ...S PSULCT=PSULCT+1
26 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,3)
27 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4))
28 ...S PSULCT=PSULCT+1
29 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4)
30 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5))
31 ...S PSULCT=PSULCT+1
32 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5)
33 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6))
34 ...S PSULCT=PSULCT+1
35 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6)
36 ;
37 ;
38MSG ;Set up the number of lines and messages for mailman
39 ;
40 S PSUNOREC="",NONE=""
41 S PSUMSGT("M")=0,PSUMSGT("L")=0
42 I '$D(^XTMP(PSUOPSUB,"RECMD")) D NODATA Q ;Do not go any further if there is no data to report
43 S PSUDIV=0,Z=0
44 F S PSUDIV=$O(^XTMP(PSUOPSUB,"RECMD",PSUDIV)) Q:PSUDIV="" D
45 .S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;**1
46 .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
47 .I PSUMASF!PSUDUZ!PSUPBMG D
48 ..D XMD,SETCNT
49 Q
50XMD ;
51 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC,PSUOLD1,PSUOLD2,PSUOLD3
52 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
53 S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
54 K ^XTMP(PSUOPSUB,"XMD")
55 S PSUMC=1,PSUMLC=0
56 F PSULC=1:1 S X=$G(^XTMP(PSUOPSUB,"RECMD",PSUDIV,PSULC)) Q:X="" D
57 .S PSUMLC=PSUMLC+1
58 .I PSUMLC>PSUMAX D
59 ..I $E(X,1)'="*" S PSUMLC=1
60 ..I $E(X,1)="*" D OLD
61 .I $L(X)<254 S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X Q
62 .F I=254:-1:1 S Z=$E(X,I) Q:Z="^"
63 .S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
64 .S PSUMLC=PSUMLC+1
65 .S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
66 ;
67 ; Count Lines sent
68 S PSUTLC=0
69 F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUOPSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
70 D VARS
71 Q
72 ;
73OLD ; THIS SUBROUTINE STOPS MULTI-LINED MESSAGES FORM SPANNING MAILMAN MSG
74 S PSUOLD1=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1) I $E(PSUOLD1,1)="*" D
75 .S PSUOLD2=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2) I $E(PSUOLD2,1)="*" D
76 ..S PSUOLD3=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3) I $E(PSUOLD3,1)="*" D
77 ...S PSUOLD4=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4) I $E(PSUOLD4,1)="*" D
78 ....S PSUOLD5=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)
79 D:$D(PSUOLD5) OLD5 Q
80 D:$D(PSUOLD4) OLD4 Q
81 D:$D(PSUOLD3) OLD3 Q
82 D:$D(PSUOLD2) OLD2 Q
83 D:$D(PSUOLD1) OLD1
84 Q
85 ;
86OLD5 ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 5 TIMES
87 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD5
88 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)
89 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD4
90 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)
91 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD3
92 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)
93 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD2
94 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
95 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,5)=PSUOLD1
96 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
97 S PSUMLC=6
98 K PSUOLD5,PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1
99 Q
100 ;
101OLD4 ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 4 TIMES
102 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD4
103 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)
104 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD3
105 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)
106 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD2
107 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
108 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD1
109 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
110 S PSUMLC=5
111 K PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1
112 Q
113 ;
114OLD3 ;
115 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD3
116 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)
117 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD2
118 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
119 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD1
120 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
121 S PSUMLC=4
122 K PSUOLD3,PSUOLD2,PSUOLD1
123 Q
124 ;
125OLD2 ;
126 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD2
127 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)
128 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD1
129 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
130 S PSUMLC=3
131 K PSUOLD2,PSUOLD1
132 Q
133 ;
134OLD1 ;
135 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD1
136 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
137 S PSUMLC=2
138 K PSUOLD1
139 Q
140 ;
141 ; Transmit Messages
142VARS ; Setup variables for contents
143 F PSUM=1:1:PSUMC D
144 .S XMSUB="V. 4.0 PBMOP(MULTIDOSE) "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
145 .S XMTEXT="^XTMP(PSUOPSUB,""XMD"",PSUM,"
146 .S XMCHAN=1
147 .I PSUMASF!PSUDUZ!PSUPBMG D
148 ..M XMY=PSUXMYH
149 .I 'PSUMASF M XMY=PSUXMYS1
150 .I '$G(PSUSMRY) D ^XMD
151 ;
152 S:NONE PSUTLC=0
153 S PSUMSG("M")=PSUMC
154 S PSUMSG("L")=PSUTLC
155 Q
156NODATA ;Send "No data to report" message
157 S ^XTMP(PSUOPSUB,"RECMD",PSUSNDR,1)="No data to report"
158 S NONE=1,PSUDIV=PSUSNDR
159 ;S ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""
160 S X=PSUDIV,DIC=4,DIC(0)="XM" D ^DIC ;**1
161 S X=+Y,PSUDIVNM=$$VAL^PSUTL(4,X,.01)
162 D XMD
163SETCNT ;Set message count and line count
164 S PSUMSGT(PSUDIV,"MD","M")=$G(PSUMSGT(PSUDIV,"MD","M"))+PSUMSG("M")
165 S PSUMSGT(PSUDIV,"MD","L")=$G(PSUMSGT(PSUDIV,"MD","L"))+PSUMSG("L")
166 S ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"MD","M")
167 S ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"MD","L")
168 Q
Note: See TracBrowser for help on using the repository browser.