source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCSR0.m@ 1806

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

initial load of WorldVistAEHR
File size: 3.8 KB
RevLine 
[613]1PSUCSR0 ;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 ;
15EN(PSUMSG) ;Scan and process for Division(s)
16 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
17 ;
18TEST 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 ;
49DIV(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 ;
83VARS(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
Note: See TracBrowser for help on using the repository browser.