| 1 | PSULR3 ;BIR/PDW - LAB extract assemble recs. for mail messg. ;25 AUG 1998
|
|---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|---|
| 3 | EN ;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 | ;
|
|---|
| 35 | RECORD() ;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
|
|---|
