source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULR5.m@ 619

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1PSULR5 ;BIR/PDW - LAB extract summary message generator ;10 JUL 1999
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;DBIA(s)
4 ; Reference to file 40.8 supported by DBIA 2438
5 ;
6EN ;EP generate Total & Cost summary
7EN1 N PSUITT,PSUREC
8 S:'$D(PSULRJOB) PSULRJOB=PSUJOB
9 S:'$D(PSULRSUB) PSULRSUB="PSULR_"_PSULRJOB
10 ;
11 ;S PSUSDT=2970101
12 ;S PSUEDT=2980501
13 I '$D(^XTMP(PSULRSUB,"RECORDS")) G NODATA
14DIV ;EP Loop by Division
15 S PSUDIV="" F S PSUDIV=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV)) Q:PSUDIV="" D MESSAGE
16 Q
17 ;
18MESSAGE ;EP Generate Summary Messages for a Division
19 ;
20 ;S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
21 ;S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
22MSG1 ; Generate 1st summary message
23 ;
24 S PSUT=0,PSUP=0 ; test & patient counters
25 ; loop to get totals from records stored
26 S DFN=0
27 F S DFN=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN)) Q:DFN'>0 S PSUP=PSUP+1 D
28 . S PSUDC="" F S PSUDC=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDC)) Q:PSUDC="" D
29 .. S PSUND=0
30 .. F S PSUND=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDC,PSUND)) Q:PSUND'>0 S PSUT=PSUT+1
31 ;
32 S XMDUZ=DUZ
33 M XMY=PSUXMYS1
34 ;
35 S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
36 S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
37 N PSUMSG
38 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
39 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
40 ;
41 I $D(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)) D
42 .;VMP OIFO BAY PINES;ELR;PSU*3.0*31
43 .I '$L($P($G(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)),U,1)) Q
44 .S PSUDIVNM=$P(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV),U,1)
45 ;
46 S PSUMSG(1)=" Laboratory Statistical Summary"
47 S PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
48 S PSUMSG(3)=" "
49 S PSUMSG(4)="Total Patients "_PSUP
50 S PSUMSG(5)="Total Laboratory Tests "_PSUT
51 S PSUMSG(6)=" "
52 S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
53 S XMTEXT="PSUMSG("
54 S XMCHAN=1
55 D ^XMD
56 M ^XTMP(PSULRSUB,"REPORT1",PSUDIV)=PSUMSG
57 K PSUMSG
58 ;
59MSG2 ; SUMMARY BY PATIENT
60 ;
61 ;
62 S PSUG="^XTMP(PSULRSUB,""REPORT2"",PSUDIV)"
63 K @PSUG
64 S @PSUG@(1)=" Laboratory Data Summary"
65 S @PSUG@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
66 S @PSUG@(3)=" "
67 S X="Patient SSN"
68 S X=$$SETSTR^VALM1("VA CODE",X,15,7)
69 S X=$$SETSTR^VALM1("Laboratory",X,24,10)
70 S X=$$SETSTR^VALM1("Results",X,42,7)
71 S X=$$SETSTR^VALM1("Flag",X,57,4)
72 S X=$$SETSTR^VALM1("Date/Time Taken",X,63,15)
73 S @PSUG@(4)=X
74 S X="",$P(X,"-",79)=""
75 S @PSUG@(5)=X
76 S PSULC=5
77 ; loop records stored
78 S DFN=0,DFN1="",PSUCD1=""
79 F S DFN=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN)) Q:DFN'>0 D S DFN1=DFN
80 . ; loop drug codes
81 . S PSUCD=""
82 . F S PSUCD=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD)) Q:PSUCD="" D S PSUCD1=PSUCD
83 .. ; loop tests
84 .. S PSUND=0
85 .. F S PSUND=$O(^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD,PSUND)) Q:PSUND'>0 D SET
86 ;
87 S @PSUG@(PSULC+1)=" "
88 S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
89 S XMTEXT="^XTMP(PSULRSUB,""REPORT2"",PSUDIV,"
90 S XMCHAN=1
91 M XMY=PSUXMYS2
92 I '$G(PSUSMRY) D ^XMD
93 Q
94 ;
95SET ;EP Set data into message
96 ;
97 S X=^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUCD,PSUND)
98 S PSULRT=$P(X,U),PSULRR=$P(X,U,2)
99 S PSULD=$P(X,U,3),PSULRF=$P(X,U,4)
100 S PSULD0=$E(PSULD,4,5)_"/"_$E(PSULD,6,7)_"/"_$E(PSULD,2,3)
101 S X=$P(PSULD,".",2),X=$E(X,1,4) F Q:$L(X)=4 S X=X_0 ; fill time
102 S PSULD=PSULD0_" "_X
103 S X=""
104 I DFN=DFN1
105 E D PID^VADPT S X=$TR(VA("PID"),"-",""),DFN1=DFN,PSUCD1="" K VA
106 I PSUCD1=PSUCD
107 E S X=$$SETSTR^VALM1(PSUCD,X,15,5) S PSUCD1=PSUCD
108 S X=$$SETSTR^VALM1(PSULRT,X,24,$L(PSULRT))
109 S X=$$SETSTR^VALM1(PSULRR,X,42,$L(PSULRR))
110 S X=$$SETSTR^VALM1(PSULRF,X,57,$L(PSULRF))
111 S X=$$SETSTR^VALM1(PSULD,X,63,$L(PSULD))
112 S PSULC=PSULC+1
113 S @PSUG@(PSULC)=X
114 ;
115 Q
116NODATA ;EP SEND NO DATA MESSAGE
117 S XMDUZ=DUZ
118 M XMY=PSUXMYS1
119 ;
120 S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
121 S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
122 S PSUDIV=PSUSNDR
123 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
124 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
125 S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
126 S XMTEXT="^XTMP(PSULRSUB,""REPORT2"",PSUDIV,"
127 S XMCHAN=1
128 K X
129 S X(1)=" Laboratory Statistical Summary"
130 S X(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
131 S X(3)=" "
132 S X(4)="No data to report"
133 S X(5)=" "
134 S XMTEXT="X("
135 S:$G(PSUDUZ) XMY(PSUDUZ)=""
136 D ^XMD
137 M ^XTMP(PSULRSUB,"REPORT1",PSUDIV)=X
138 S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
139 S X(1)=" Laboratory Data Summary"
140 M ^XTMP(PSULRSUB,"REPORT2",PSUDIV)=X ;store for print cycle
141 Q
Note: See TracBrowser for help on using the repository browser.