source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUUD4.m@ 623

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PSUUD4 ;BIR/TJH - PBM UNIT DOSE 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,2596
5 ; Reference to file #40.8 supported by DBIA 2438
6 ;
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(PSUMSGT) ;Scan and process for Division(s)
16 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
17 ;
18 S PSUDIV=0,Z=0,PSUUDSUB="PSUUD_"_PSUJOB
19 F S PSUDIV=$O(^XTMP(PSUUDSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
20 . D XMD^PSUUD4(.Z) ; ==> process one division
21 . S PSUMSGT(PSUDIV,PSUOPTN,"M")=$G(PSUMSGT(PSUDIV,PSUOPTN,"M"))+Z("M")
22 . S PSUMSGT(PSUDIV,PSUOPTN,"L")=$G(PSUMSGT(PSUDIV,PSUOPTN,"L"))+Z("L")
23 Q
24XMD(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES
25 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
26 ; Scan TMP, split lines, transmit per MAX lines in Netmail
27 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
28 S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
29 ;
30 ; Split and store into ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)
31 K ^XTMP(PSUUDSUB,"XMD")
32 S PSUMC=1,PSUMLC=0
33 F PSULC=1:1 S X=$G(^XTMP(PSUUDSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
34 . S PSUMLC=PSUMLC+1
35 . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message
36 . I $L(X)<235 S ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)=X Q
37 . F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
38 . S ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
39 . S PSUMLC=PSUMLC+1
40 . S ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
41 ; Count Lines sent
42 S PSUTLC=0
43 F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUUDSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
44 ; Transmit Messages
45VARS ; Setup variables for contents
46 ;
47 F PSUM=1:1:PSUMC D
48 . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
49 . S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
50 . S ^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)=PSUDIVNM
51 . I '$D(PSUUDFLG) S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
52 . I $D(PSUUDFLG) S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUDIV_" "_PSUDIVNM
53 . S XMTEXT="^XTMP(PSUUDSUB,""XMD"",PSUM,"
54 . S XMDUZ=DUZ
55 . M XMY=PSUXMY
56 . S XMCHAN=1
57 . M XMY=PSUXMY
58 . I PSUMASF!PSUDUZ!PSUPBMG D ^XMD
59 ;
60 S PSUMSG("M")=PSUMC
61 S PSUMSG("L")=PSUTLC
62 Q
63 ;
Note: See TracBrowser for help on using the repository browser.