| 1 | PSULR2 ;BIR/PDW - PBM LAB EXTRACT PROCESS PATIENTS ;25 AUG 1998
|
|---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | ;DBIA'S
|
|---|
| 5 | ; Reference to file #2 supported by DBIA 10035
|
|---|
| 6 | ; Reference to file #63 supported by DBIA 2524
|
|---|
| 7 | ;
|
|---|
| 8 | EN ;EP SCAN AND SPLIT INTO DIVISION,RECORDS
|
|---|
| 9 | ; Build ^XTMP(,,"RECORDS",PSUDIV,L)
|
|---|
| 10 | ; Build ^XTMP(,,"PATIENT",DFN,TEST)="" AND THEN
|
|---|
| 11 | ; ,DATE)=RESULT^FLAG
|
|---|
| 12 | K ^XTMP(PSULRSUB,"RECORDS"),^("PATIENTS")
|
|---|
| 13 | ; Gather the tests necessary for each patient
|
|---|
| 14 | S PSUDA="" F S PSUDA=$O(^XTMP(PSULRSUB,"EVENT",PSUDA)) Q:PSUDA'>0 S X=^(PSUDA) D TESTS
|
|---|
| 15 | ;
|
|---|
| 16 | ; with the tests gathered for each patient
|
|---|
| 17 | ; now scan each patients daily lab results looking for the tests
|
|---|
| 18 | D PATIENT
|
|---|
| 19 | Q
|
|---|
| 20 | TESTS ;EP Gather tests for a patient for the drug class
|
|---|
| 21 | ; nodes used in ^XTMP sampler
|
|---|
| 22 | ;^XTMP("PSULR_541074170","CODES","CV800",6) = POTASSIUM
|
|---|
| 23 | ;^XTMP("PSULR_541074170","EVENT",1) = IV^599^13^12345^ASPRIN^CV800
|
|---|
| 24 | ;^XTMP("PSULR_541074170","PATIENT",13,4) = CREATININE
|
|---|
| 25 | ;^XTMP("PSULR_541074170","PATIENT",13,4,7029388.859632) = 1.0^^^50
|
|---|
| 26 | ;^XTMP("PSULR_541074170","PATIENT",13,6) = POTASSIUM
|
|---|
| 27 | ;^XTMP("PSULR_541074170","PATIENT",13,6,7029388.859632) = 5.0^^^50
|
|---|
| 28 | ;
|
|---|
| 29 | ; lab test "ch" node locations for each drug class were built in PSULR1
|
|---|
| 30 | ; Setup "Patient",ch node)="" by codes and tests built in XTMP(,,"CODES",TEST node)=test name
|
|---|
| 31 | ;
|
|---|
| 32 | S PSUDRCD=$P(X,U,6),PSUDFN=$P(X,U,3)
|
|---|
| 33 | S PSULRND=0 F S PSULRND=$O(^XTMP(PSULRSUB,"CODES",PSUDRCD,PSULRND)) Q:PSULRND'>0 S X=^(PSULRND) D
|
|---|
| 34 | . S ^XTMP(PSULRSUB,"PATIENT",PSUDFN,PSULRND)=X
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | PATIENT ;EP SCAN for each patient their tests needed
|
|---|
| 38 | ;Take ^XTMP(,"PATIENT","CH TEST NODE")=TESTNAME
|
|---|
| 39 | ;scan the lab file
|
|---|
| 40 | ;and build
|
|---|
| 41 | ; ^XTMP(,"PATIENT","CH TEST NODE",DATE)=RESULT^TESTFLAG
|
|---|
| 42 | ;
|
|---|
| 43 | S X1=PSUEDT,X2=-365 D C^%DTC
|
|---|
| 44 | ;S X1=PSUSDT,X2=-365 D C^%DTC
|
|---|
| 45 | S PSULREDT=9999999-X ; only go back one year
|
|---|
| 46 | S PSULRSDT=9999999-PSUSDT
|
|---|
| 47 | ;
|
|---|
| 48 | ; gather needed test (nodes) from ^XTMP and put into the X to PSUNODE array
|
|---|
| 49 | ;
|
|---|
| 50 | S DFN=0 F K X S DFN=$O(^XTMP(PSULRSUB,"PATIENT",DFN)) Q:DFN'>0 M X=^(DFN) D
|
|---|
| 51 | . N PSUNODE
|
|---|
| 52 | . ; psunode("CH" NODE)=test name
|
|---|
| 53 | . M PSUNODE=X
|
|---|
| 54 | . I '$D(^DPT(DFN,"LR")) Q
|
|---|
| 55 | . S PSULRDFN=^DPT(DFN,"LR")
|
|---|
| 56 | . S DA=PSULRSDT F S DA=$O(^LR(PSULRDFN,"CH",DA)) Q:DA'>0 Q:'$D(PSUNODE) Q:DA>PSULREDT D
|
|---|
| 57 | .. ; check each date for each ch node in PSUNODE
|
|---|
| 58 | .. S Y=0 F S Y=$O(PSUNODE(Y)) Q:Y'>0 I $D(^LR(PSULRDFN,"CH",DA,Y)) D
|
|---|
| 59 | ... ;found a test, save result & quit testing for the node
|
|---|
| 60 | ... I '$P(^LR(PSULRDFN,"CH",DA,0),U,3) Q ; results not verified
|
|---|
| 61 | ... S ^XTMP(PSULRSUB,"PATIENT",DFN,Y,DA)=^LR(PSULRDFN,"CH",DA,Y)
|
|---|
| 62 | ... K PSUNODE(Y)
|
|---|
| 63 | ;
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
