source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUPR4.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1PSUPR4 ;BIR/PDW - PBMS PROCUREMENT EMAIL GENERATOR ;10 JUL 1999
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;DBIA(s)
4 ; Reference to file #4.3 supported by DBIA 2496
5 ; Reference to file #40.8 supported by DBIA 2438
6 ;PSULC = Line processing in ^tmp
7 ;PSUTLC = Total Line count
8 ;PSUMC = Message counter
9 ;PSUMLC = Message Line Counter
10 ; RETURNS
11 ;PSUMSG("M") = # Messages
12 ;PSUMSG("L") = # Lines
13 ;
14EN(PSUMSG) ;Scan and process for Division(s)
15 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
16 ;
17 I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
18 .NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
19 .; Scan TMP, split lines, transmit per MAX lines in Netmail
20 .S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
21 .S:PSUMAX'>0 PSUMAX=10000
22 .;
23 .I '$D(^XTMP(PSUPRSUB,"RECORDS")) D NODATA Q
24DIV .; Scan by division and send divisional messages
25 .;
26 .S PSUDIV="" F S PSUDIV=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MSG
27 Q
28 ;
29MSG ;EP Send divisional message
30 ; Split and store into ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSULC)
31 K ^XTMP(PSUPRSUB,"MESSAGE")
32 S PSUMC=1,PSUMLC=0
33 F PSULC=1:1 S X=$G(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
34 . I $D(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1)) S X=X_^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1)
35 . S PSUMLC=PSUMLC+1
36 . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC+1 Q ; + message
37 . I $L(X)<235 S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=X Q
38 . F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
39 . S Z=$E(X,1,I),X=$E(X,I+1,999)
40 . S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=Z
41 . S PSUMLC=PSUMLC+1
42 . F Q:X="" D
43 .. F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
44 .. S Z=$E(X,1,I),X=$E(X,I+1,999)
45 .. S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_Z
46 .. S PSUMLC=PSUMLC+1
47 ;
48 ; Count Lines sent
49 S PSUTLC=0
50 F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUPRSUB,"MESSAGE",PSUM,""),-1),PSUTLC=PSUTLC+X
51 ;
52 S PSUMSG(PSUDIV,5,"M")=$G(PSUMSG(PSUDIV,5,"M"))+PSUMC
53 S PSUMSG(PSUDIV,5,"L")=$G(PSUMSG(PSUDIV,5,"L"))+PSUTLC
54 ; Transmit Messages
55VARS ; Setup variables for contents
56 ;
57 ; Loop through messages generated and transmit them
58 F PSUM=1:1:PSUMC D
59 . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
60 . S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
61 . S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
62 . S XMTEXT="^XTMP(PSUPRSUB,""MESSAGE"",PSUM,"
63 . S XMDUZ=DUZ
64 . M XMY=PSUXMYH
65 . S XMCHAN=1
66 . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
67 ..I '$G(PSUSMRY) D ^XMD
68 ;
69 Q
70NODATA ;EP transmit NO DATA FOUND
71 S XMDUZ=DUZ
72 M XMY=PSUXMYH
73 S PSUM=1,PSUMC=1
74 S PSUDIV=PSUSNDR
75 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
76 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
77 S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
78 S X(1)="No data to report"
79 S XMTEXT="X("
80 S XMCHAN=1
81 I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D ^XMD
82 S PSUMSG(PSUDIV,5,"M")=1,PSUMSG(PSUDIV,5,"L")=0
83 Q
Note: See TracBrowser for help on using the repository browser.