source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULR4.m@ 1093

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

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1PSULR4 ;BIR/PDW - PBMS LABORATORY EMAIL GENERATOR ;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,10091
6 ; Reference to file #40.8 supported by DBIA 2438
7 ;PSULC = Line processing in ^tmp
8 ;PSUTLC = Total Line count
9 ;PSUMC = Message counter
10 ;PSUMLC = Message Line Counter
11 ; RETURNS
12 ;PSUMSG("M") = # Messages
13 ;PSUMSG("L") = # Lines
14 ;
15EN(PSUMSG) ;Scan and process for Division(s)
16 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
17 ;
18 ;I '$G(PSUMASF) Q ;Comment out so user can get detailed msg
19 ;regardless of whether they send to Hines or not
20 ;
21 ;
22 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
23 ; Scan TMP, split lines, transmit per MAX lines in Netmail
24 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
25 S:PSUMAX'>0 PSUMAX=10000
26 ;
27 I '$D(^XTMP(PSULRSUB,"RECORDS")) G NODATA
28DIV ; Scan by division and send divisional messages
29 ;
30 S PSUDIV="" F S PSUDIV=$O(^XTMP(PSULRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MSG
31 Q
32 ;
33MSG ;EP Send divisional message
34 ; Split and store into ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSULC)
35 K ^XTMP(PSULRSUB,"MESSAGE")
36 S PSUMC=1,PSUMLC=0
37 F PSULC=1:1 S X=$G(^XTMP(PSULRSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
38 . S PSUMLC=PSUMLC+1
39 . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message
40 . I $L(X)<235 S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=X Q
41 . F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
42 . S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=$E(X,1,I)
43 . S PSUMLC=PSUMLC+1
44 . S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
45 ;
46 ; Count Lines sent
47 S PSUTLC=0
48 F PSUM=1:1:PSUMC S X=$O(^XTMP(PSULRSUB,"MESSAGE",PSUM,""),-1),PSUTLC=PSUTLC+X
49 ;
50 S PSUMSG(PSUDIV,13,"M")=+$G(PSUMSG(PSUDIV,13,"M"))+PSUMC
51 S PSUMSG(PSUDIV,13,"L")=+$G(PSUMSG(PSUDIV,13,"L"))+PSUTLC
52TRANS ;EP Transmit Messages
53VARS ; Setup variables for contents
54 ;
55 I $D(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)) D Q
56 .F PSUM=1:1:PSUMC D
57 ..S PSUDIVNM=$P(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV),U,1)
58 ..S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
59 ..S XMDUZ=DUZ
60 ..S XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
61 ..M XMY=PSUXMYH
62 ..S XMCHAN=1
63 ..I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
64 ...I PSUSMRY'=1 D ^XMD
65 ;
66 ; Loop through messages generated and transmit them
67 F PSUM=1:1:PSUMC D
68 . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
69 . S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
70 . S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
71 . S XMDUZ=DUZ
72 . S XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
73 . M XMY=PSUXMYH
74 . S XMCHAN=1
75 . ;I $G(PSUMASF) D ^XMD
76 . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
77 ..I PSUSMRY'=1 D ^XMD
78 ;
79 Q
80NODATA ;EP transmit NO DATA FOUND
81 S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99)
82 S PSUDIV=PSUSNDR
83 S PSUMSG(PSUDIV,13,"M")=$G(PSUMASF),PSUMSG(PSUDIV,13,"L")=0
84 S XMDUZ=DUZ
85 M XMY=PSUXMYH
86 S PSUM=1,PSUMC=1
87 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
88 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
89 S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
90 S X(1)="No data to report"
91 S XMTEXT="X("
92 S XMCHAN=1
93 I $G(PSUMASF)!$G(PSUPBMG)!$G(PSUDUZ) D ^XMD
94 Q
Note: See TracBrowser for help on using the repository browser.