source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCP2.m@ 1327

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PSUCP2 ;BIR/TJH - CHECK COMPLETION OF MONTHLY PBM REPORT ;25 AUG 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIAs
5 ; Reference to File #4 supported by DBIA 10090
6 ; Reference to File #4.3 supported by DBIA 10091
7 ; Reference to File #40.8 supported by DBIA 2438
8 ; Reference to File #59.7 supported by DBIA 2854
9 ;
10MANUAL ; Entry point if tasked by PSU PBM MANUAL option
11 S PSUWAY="Manual"
12AUTO ; Entry point if tasked by PSU PBM AUTO option
13 I '$D(PSUWAY) S PSUWAY="Automatic"
14 D NOW^%DTC
15 S PSUNOW=% K %,%H,%I,X
16 S PSULRD=$$VALI^PSUTL(59.7,1,90) ; last run date
17 D
18 .I PSULRD="" S PSUOK=0 Q ; it's 24 hours later and finish time is not set, may be a problem.
19 .S X1=PSUNOW,X2=PSULRD D ^%DTC
20 .I X>6 S PSUOK=0 Q ; the last run date must be left over from a previous run, it's a problem.
21 .S PSUOK=1
22 G:PSUOK EXIT ; no message sent if OK.
23 D XMY^PSUTL1
24 M XMY=PSUXMYS1
25 I $G(PSUMASF) M XMY=PSUXMYH
26 S X=$$VALI^PSUTL(4.3,1,217),PSUDIV=+$$VAL^PSUTL(4,X,99)
27 S X=PSUDIV,DIC=40.8,DIC(0)="XM" D ^DIC
28 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
29 S XMSUB="PBM "_PSUWAY_" Statistics Job "_PSUDIV_" "_PSUDIVNM
30 S X(1)="The PBM "_PSUWAY_" Statistics background job did not run to completion."
31 S X(2)="Please correct the problem and retransmit the data to the National PBM"
32 S X(3)="section at Hines."
33 S XMTEXT="X("
34 S XMCHAN=1
35 D ^XMD
36EXIT ; normal exit point from PSUCP2
37 K PSUWAY,PSUNOW,PSULRD,PSUOK,PSUDIV,PSUDIVNM
38 Q
39MMNOMAP ; Generate MM regarding locations not mapped
40 Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;Quit if user does not want a
41 ;copy sent to self
42 ;
43 N TXT1,TXT2
44 ;
45 D PULL^PSUCP
46 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
47 S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99),PSUNAME=$$VAL^PSUTL(4,X,.01)
48 K TXT
49 S TXT(1)="The locations listed below have not been mapped to a Medical Center"
50 S TXT(2)="Division or Outpatient Site. All data extracted from these locations have"
51 S TXT(3)="been attributed to "_PSUSNDR_" "_PSUNAME
52 S TXT(4)=" "
53 S TLC=4
54 ;
55 I $D(PSUARSUB) D
56 .I $D(^XTMP(PSUARSUB,"AOU")),$D(PSUMOD(3)) D
57 ..K AOUNMAP,MAP ;Array to hold unmapped AOU data
58 ..N LOC,LOC1
59 ..M MAP=^XTMP(PSUARSUB,"AOU")
60 ..F TXT=" ","AOUs:" D TXT
61 ..S IEN=0 F S IEN=$O(MAP(IEN)) Q:IEN="" D
62 ...S LOC=MAP(IEN,.01)
63 ...M AOUNMAP(LOC)=MAP(IEN)
64 ..S LOC1=0
65 ..F S LOC1=$O(AOUNMAP(LOC1)) Q:LOC1="" D
66 ...S TXT1=AOUNMAP(LOC1,.01)
67 ...S TXT2=$G(AOUNMAP(LOC1,3)) I TXT2'="" S TXT2=" **INACTIVE**"
68 ...S TXT=TXT1_TXT2 D TXT
69 .;
70 .I '$D(^XTMP(PSUARSUB,"AOU")),$D(PSUMOD(3)) D
71 ..F TXT=" ","AOUs:" D TXT
72 ..S TXT="There are no unmapped AOU's for the dates of this extract" D TXT
73 ;
74 I $D(PSUARSUB) D
75 .I $D(^XTMP(PSUARSUB,"NAOU")),$D(PSUMOD(6)) D
76 ..K NAOUMAP,MAP
77 ..N LOC,LOC1
78 ..M MAP=^XTMP(PSUARSUB,"NAOU")
79 ..F TXT="","NAOUs:" D TXT
80 ..S IEN=0 F S IEN=$O(MAP(IEN)) Q:IEN'>0 D
81 ...S LOC=MAP(IEN,.01)
82 ...M NAOUMAP(LOC)=MAP(IEN)
83 ..S LOC1=0
84 ..F S LOC1=$O(NAOUMAP(LOC1)) Q:LOC1="" D
85 ...S TXT1=NAOUMAP(LOC1,.01)
86 ...S TXT2=$G(NAOUMAP(LOC1,4)) I TXT2'="" S TXT2=" **INACTIVE**"
87 ...S TXT=TXT1_TXT2 D TXT
88 .;
89 .I '$D(^XTMP(PSUARSUB,"NAOU")),$D(PSUMOD(6)) D
90 .. F TXT=" ","NAOUs:" D TXT
91 ..S TXT="There are no unmapped NAOU's for the dates of this extract" D TXT
92 ;
93 I $D(PSUARSUB) D
94 .I $D(^XTMP(PSUARSUB,"DAPH")),$D(PSUMOD(5)) D
95 ..K DAPH,MAP
96 ..N LOC,LOC1
97 ..M MAP=^XTMP(PSUARSUB,"DAPH")
98 ..F TXT="","DA Pharmacy Locations:" D TXT
99 ..S IEN=0 F S IEN=$O(MAP(IEN)) Q:IEN'>0 D
100 ...S LOC=MAP(IEN,.01)
101 ...M DAPH(LOC)=MAP(IEN)
102 ..S LOC1=0
103 ..F S LOC1=$O(DAPH(LOC1)) Q:LOC1="" D
104 ...S TXT1=DAPH(LOC1,.01)
105 ...S TXT2=$G(DAPH(LOC1,4)) I TXT2'="" S TXT2=" **INACTIVE**"
106 ...S TXT=TXT1_TXT2 D TXT
107 .;
108 .I '$D(^XTMP(PSUARSUB,"DAPH")),$D(PSUMOD(5)) D
109 .. F TXT=" ","DA Pharmacy Locations:" D TXT
110 ..S TXT="There are no unmapped DA Pharmacy Locations for the dates of this extract" D TXT
111 ;
112MSGNOMAP ; send MM
113 ;
114 S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y
115 S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y
116 S XMSUB="PBM Unmapped Locations for "_PSUDTS_" to "_PSUDTE_" from "_PSUSNDR_" "_PSUNAME
117 S XMTEXT="TXT("
118 S XMY("G.PSU PBM")=""
119 S XMY(DUZ)=""
120 I $D(PSUARSUB) D ^XMD
121 Q
122 ;
123TXT S TLC=TLC+1,TXT(TLC)=TXT
124 Q
Note: See TracBrowser for help on using the repository browser.