Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSULR3

PSULR3.m

Go to the documentation of this file.
  1. PSULR3 ;BIR/PDW - LAB extract assemble recs. for mail messg. ;25 AUG 1998
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. EN ;EP
  1. ;
  1. ;
  1. ; Samples of the XTMP records being used
  1. ;
  1. ;^XTMP("PSULR_541075670",541075670,"CODES","CV800",4) = CREATININE^mg/dL
  1. ;^XTMP("PSULR_541075670",541075670,"EVENT",1) = IV^599^13^12345^ASPRIN^CV800
  1. ;^XTMP("PSULR_541075670",541075670,"PATIENT",13,4) = CREATININE^mg/dL
  1. ;^XTMP("PSULR_541075670",541075670,"PATIENT",13,4,7029388.859632) = 1.0^^^50
  1. ;^XTMP("PSULR_541077558",541077558,"RECORDS",59,1) = ^59^^^^12345^^^^^^ASPRIN^^CREATININE^^^^1.0 mg/dL^^6/10/97^
  1. ;^XTMP("PSULR_541077558",541077558,"SUMMARY",599,13,"CV800",4) = CREATININE^1.0 mg/dL^6/10/97^
  1. ;
  1. ; LOOP through the events and assemble records accordingly
  1. K ^XTMP(PSULRSUB,"RECORDS")
  1. K ^XTMP(PSULRSUB,"SUMMARY")
  1. S PSUEV=0 F S PSUEV=$O(^XTMP(PSULRSUB,"EVENT",PSUEV)) Q:PSUEV'>0 S X=^(PSUEV) D
  1. . ;W !,X
  1. . S PSUPK=$P(X,U,1),PSUDIV=$P(X,U,2),DFN=$P(X,U,3)
  1. . S PSUORD=$P(X,U,4),PSUDRGN=$P(X,U,5),PSUDRCD=$P(X,U,6)
  1. . K PSUCD
  1. . M PSUCD=^XTMP(PSULRSUB,"CODES",PSUDRCD)
  1. . S PSUND=0 F S PSUND=$O(PSUCD(PSUND)) Q:PSUND'>0 D
  1. .. S PSUDT=$O(^XTMP(PSULRSUB,"PATIENT",DFN,PSUND,0))
  1. .. I 'PSUDT Q ; no test results found
  1. .. K VA D PID^VADPT
  1. .. S PSUX=$$RECORD()
  1. .. K VA
  1. .. S PSULC=$O(^XTMP(PSULRSUB,"RECORDS",PSUDIV,""),-1)+1
  1. .. S ^XTMP(PSULRSUB,"RECORDS",PSUDIV,PSULC)=PSUX
  1. ;
  1. Q
  1. ;
  1. RECORD() ;EP Construct mailing record
  1. ;3.2.11.42
  1. K PSUR
  1. S PSULRDT=9999999-PSUDT
  1. S X=^XTMP(PSULRSUB,"PATIENT",DFN,PSUND,PSUDT)
  1. S PSULRF=$S(X["^":$P(X,U,2),1:"") ; hi/low flag
  1. S PSULRR=$S(X["^":$P(X,U),1:X) ; test result
  1. S X=^XTMP(PSULRSUB,"PATIENT",DFN,PSUND)
  1. S PSULRT=$P(X,U) ; Lab Test name stored
  1. S PSULRU=$P(X,U,2) ; Units stored
  1. K PSUR
  1. S PSUR(2)=PSUDIV
  1. S PSUR(3)=$TR(VA("PID"),"-","")
  1. S X=$S(PSUPK="IV":4,PSUPK="UD":5,1:10)
  1. S PSUR(X)=PSUORD
  1. S PSUR(7)=PSUDRGN
  1. S PSUR(8)=$P(PSULRT,U)
  1. S PSUR(9)=PSULRR_" "_PSULRU
  1. S PSUR(10)=PSULRF
  1. S PSUR(11)=PSULRDT
  1. S PSUR=""
  1. S I=0 F S I=$O(PSUR(I)) Q:I'>0 S PSUR(I)=$TR(PSUR(I),"^","'")
  1. S I=0 F S I=$O(PSUR(I)) Q:I'>0 S $P(PSUR,U,I)=PSUR(I)
  1. S PSUR=PSUR_U
  1. ; Store info for summary by patient
  1. S PSUTEST=PSULRT_U_PSUR(9)_U_PSULRDT_U_PSULRF ; test^result unit^date^flag
  1. S ^XTMP(PSULRSUB,"SUMMARY",PSUDIV,DFN,PSUDRCD,PSUND)=PSUTEST
  1. Q PSUR