1 | PSUCSR0 ;BIR/DJM,DJE - Extract records for CS ;25 AUG 1998
|
---|
2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
---|
3 | ;
|
---|
4 | ; 3.2.11.34 Functional Requirement 34
|
---|
5 | ;-------------------------------------
|
---|
6 | ;
|
---|
7 | ; 3.2.11.35 Functional Requirement 35
|
---|
8 | ;-------------------------------------
|
---|
9 | ;DBIA(S)
|
---|
10 | ; Reference to file #4.3 supported by DBIA 2496
|
---|
11 | ; Reference to file #40.8 supported by DBIA 2438
|
---|
12 | ;
|
---|
13 | ; ----- SEE SPECS FOR DETAIL
|
---|
14 | ;
|
---|
15 | EN(PSUMSG) ;Scan and process for Division(s)
|
---|
16 | ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
|
---|
17 | ;
|
---|
18 | TEST S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
|
---|
19 | S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
|
---|
20 | S PSUDUZ=$G(PSUDUZ,DUZ)
|
---|
21 | S PSUDIV=0,Z=0
|
---|
22 | S:'$D(PSUCSJB) PSUCSJB="PSUCS_"_PSUJOB
|
---|
23 | S PSUMC=0 ; No messages set yet
|
---|
24 | K ^XTMP(PSUCSJB,"MAIL")
|
---|
25 | K ^XTMP(PSUCSJB,"REPORT")
|
---|
26 | K ^XTMP(PSUCSJB,"CSFR-37")
|
---|
27 | S PSUXMY(DUZ)="" ; *** TESTING
|
---|
28 | I '$D(PSUXMY) S PSUXMY(PSUDUZ)="" ; THIS IS WHO WE MAIL TO
|
---|
29 | N Z ; Z used to pass back "CONFIRM" numbers
|
---|
30 | F S PSUDIV=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
|
---|
31 | . S PSUMSEQ=0
|
---|
32 | . D DIV(.Z) ; Process a single divisions data extract
|
---|
33 | . D SUMMRY^PSUCSR1(.Z) ; Send the summary report(s)
|
---|
34 | ; PSUMC holding a variable
|
---|
35 | I PSUMC=0 D ; No data to send messages
|
---|
36 | . S PSUMSEQ=0,PSUDIV=PSUSNDR
|
---|
37 | . D DIV(.Z)
|
---|
38 | . D SUMMRY^PSUCSR1(.Z)
|
---|
39 | D VARS("MAIL",1,PSUMC)
|
---|
40 | M ^XTMP("PSU_"_$G(PSUJOB,$J),"CONFIRM")=Z
|
---|
41 | Q
|
---|
42 | ; 3.2.11.36 Functional Requirement 36
|
---|
43 | ;-------------------------------------
|
---|
44 | ;
|
---|
45 | ; 3.2.11.37 Functional Requirement 37
|
---|
46 | ;-------------------------------------
|
---|
47 | ;
|
---|
48 | ;
|
---|
49 | DIV(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES
|
---|
50 | ; Scan TMP, split lines, transmit per MAX lines in Netmail
|
---|
51 | S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
|
---|
52 | S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
|
---|
53 | ;
|
---|
54 | ; Split and store into ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)
|
---|
55 | S PSUOMC=PSUMC,PSUMC=PSUMC+1,PSUMSEQ=PSUMSEQ+1,PSUMLC=0
|
---|
56 | K ^XTMP(PSUCSJB,"MAIL",PSUMC)
|
---|
57 | S PSUTIEN="",PSULC=0,PSUTLC=0
|
---|
58 | F S PSUTIEN=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN)) Q:PSUTIEN="" D
|
---|
59 | . S PSULC=PSULC+1
|
---|
60 | . S PSURC=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,""))
|
---|
61 | . S X=$G(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,PSURC))
|
---|
62 | . D EN^PSUCSR1 ; Prepare data for next report (drug breakdown)
|
---|
63 | . Q:$G(PSUSMRY) ; Only do a summary
|
---|
64 | . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D ; Detail to Hines,self,group
|
---|
65 | .. S PSUMLC=PSUMLC+1,PSUTLC=PSUTLC+1
|
---|
66 | .. I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC+1 Q ; + message
|
---|
67 | .. I $L(X)<235 S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=X Q
|
---|
68 | .. F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
|
---|
69 | .. S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=$E(X,1,I)
|
---|
70 | .. S PSUMLC=PSUMLC+1
|
---|
71 | .. S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
|
---|
72 | ; Go mail the message now
|
---|
73 | ;I '$G(PSUMASF) S PSUMC=PSUMC-1 Q ; Do not update the master file, commented out to send detailed message to user DAM
|
---|
74 | I PSUMLC=0 D
|
---|
75 | . S PSUMLC=PSUMLC+1
|
---|
76 | . S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="No data to report"
|
---|
77 | S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
|
---|
78 | S ^XTMP(PSUCSJB,"DETAIL",PSUMC)=PSUMSEQ_"/"_(PSUMC-PSUOMC)
|
---|
79 | S PSUMSG(PSUDIV,6,"M")=$G(PSUMSG(PSUDIV,6,"M"))+(PSUMC-PSUOMC)
|
---|
80 | S PSUMSG(PSUDIV,6,"L")=$G(PSUMSG(PSUDIV,6,"L"))+PSUMLC
|
---|
81 | Q
|
---|
82 | ;
|
---|
83 | VARS(PSUMMS,S,E) ; Setup variables for contents
|
---|
84 | S PSUMC=0,PSUTLC=0
|
---|
85 | S XMDUZ=PSUDUZ
|
---|
86 | F PSUM=S:1:E D
|
---|
87 | . Q:'$D(^XTMP(PSUCSJB,"MAIL",PSUM))
|
---|
88 | . S PSUMC=PSUMC+1
|
---|
89 | . S PSUMLC=$O(^XTMP(PSUCSJB,"MAIL",PSUM,""),-1),PSUTLC=PSUTLC+PSUMLC
|
---|
90 | . S PSUDIV=^XTMP(PSUCSJB,"MAIL",PSUM)
|
---|
91 | . I $D(^XTMP(PSUCSJB,"DETAIL",PSUM)) M XMY=PSUXMYH
|
---|
92 | . I $D(^XTMP(PSUCSJB,"SUMMARY 1",PSUM)) M XMY=PSUXMYS1
|
---|
93 | . I $D(^XTMP(PSUCSJB,"SUMMARY 2",PSUM)) M XMY=PSUXMYS2
|
---|
94 | . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
|
---|
95 | . S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
---|
96 | . S PSUMSEQ=$G(^XTMP(PSUCSJB,"DETAIL",PSUM)) ; Get the mail sequence data
|
---|
97 | . S PSUMSEQ=$S(PSUMSEQ="":" ",1:" "_PSUMSEQ_" ")
|
---|
98 | . S XMSUB="V. 4.0 PBMCS "_PSUMON_PSUMSEQ_PSUDIV_" "_PSUDIVNM
|
---|
99 | . S XMTEXT="^XTMP(PSUCSJB,PSUMMS,PSUM,"
|
---|
100 | . S XMCHAN=1
|
---|
101 | . D ^XMD
|
---|
102 | ;
|
---|
103 | Q
|
---|