source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULR3.m@ 701

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PSULR3 ;BIR/PDW - LAB extract assemble recs. for mail messg. ;25 AUG 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3EN ;EP
4 ;
5 ;
6 ; Samples of the XTMP records being used
7 ;
8 ;^XTMP("PSULR_541075670",541075670,"CODES","CV800",4) = CREATININE^mg/dL
9 ;^XTMP("PSULR_541075670",541075670,"EVENT",1) = IV^599^13^12345^ASPRIN^CV800
10 ;^XTMP("PSULR_541075670",541075670,"PATIENT",13,4) = CREATININE^mg/dL
11 ;^XTMP("PSULR_541075670",541075670,"PATIENT",13,4,7029388.859632) = 1.0^^^50
12 ;^XTMP("PSULR_541077558",541077558,"RECORDS",59,1) = ^59^^^^12345^^^^^^ASPRIN^^CREATININE^^^^1.0 mg/dL^^6/10/97^
13 ;^XTMP("PSULR_541077558",541077558,"SUMMARY",599,13,"CV800",4) = CREATININE^1.0 mg/dL^6/10/97^
14 ;
15 ; LOOP through the events and assemble records accordingly
16 K ^XTMP(PSULRSUB,"RECORDS")
17 K ^XTMP(PSULRSUB,"SUMMARY")
18 S PSUEV=0 F S PSUEV=$O(^XTMP(PSULRSUB,"EVENT",PSUEV)) Q:PSUEV'>0 S X=^(PSUEV) D
19 . ;W !,X
20 . S PSUPK=$P(X,U,1),PSUDIV=$P(X,U,2),DFN=$P(X,U,3)
21 . S PSUORD=$P(X,U,4),PSUDRGN=$P(X,U,5),PSUDRCD=$P(X,U,6)
22 . K PSUCD
23 . M PSUCD=^XTMP(PSULRSUB,"CODES",PSUDRCD)
24 . S PSUND=0 F S PSUND=$O(PSUCD(PSUND)) Q:PSUND'>0 D
25 .. S PSUDT=$O(^XTMP(PSULRSUB,"PATIENT",DFN,PSUND,0))
26 .. I 'PSUDT Q ; no test results found
27 .. K VA D PID^VADPT
28 .. S PSUX=$$RECORD()
29 .. K VA
30 .. S PSULC=$O(^XTMP(PSULRSUB,"RECORDS",PSUDIV,""),-1)+1
31 .. S ^XTMP(PSULRSUB,"RECORDS",PSUDIV,PSULC)=PSUX
32 ;
33 Q
34 ;
35RECORD() ;EP Construct mailing record
36 ;3.2.11.42
37 K PSUR
38 S PSULRDT=9999999-PSUDT
39 S X=^XTMP(PSULRSUB,"PATIENT",DFN,PSUND,PSUDT)
40 S PSULRF=$S(X["^":$P(X,U,2),1:"") ; hi/low flag
41 S PSULRR=$S(X["^":$P(X,U),1:X) ; test result
42 S X=^XTMP(PSULRSUB,"PATIENT",DFN,PSUND)
43 S PSULRT=$P(X,U) ; Lab Test name stored
44 S PSULRU=$P(X,U,2) ; Units stored
45 K PSUR
46 S PSUR(2)=PSUDIV
47 S PSUR(3)=$TR(VA("PID"),"-","")
48 S X=$S(PSUPK="IV":4,PSUPK="UD":5,1:10)
49 S PSUR(X)=PSUORD
50 S PSUR(7)=PSUDRGN
51 S PSUR(8)=$P(PSULRT,U)
52 S PSUR(9)=PSULRR_" "_PSULRU
53 S PSUR(10)=PSULRF
54 S PSUR(11)=PSULRDT
55 S PSUR=""
56 S I=0 F S I=$O(PSUR(I)) Q:I'>0 S PSUR(I)=$TR(PSUR(I),"^","'")
57 S I=0 F S I=$O(PSUR(I)) Q:I'>0 S $P(PSUR,U,I)=PSUR(I)
58 S PSUR=PSUR_U
59 ; Store info for summary by patient
60 S PSUTEST=PSULRT_U_PSUR(9)_U_PSULRDT_U_PSULRF ; test^result unit^date^flag
61 S ^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDRCD,PSUND)=PSUTEST
62 Q PSUR
Note: See TracBrowser for help on using the repository browser.