source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULR2.m@ 724

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PSULR2 ;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 ;
8EN ;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
20TESTS ;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 ;
37PATIENT ;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 ;
Note: See TracBrowser for help on using the repository browser.