PSULR2.m

PSULR2 ;BIR/PDW - PBM LAB EXTRACT  PROCESS PATIENTS ;25 AUG 1998

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 ;

 ;DBIA'S

 ; Reference to file #2  supported by DBIA 10035

 ; Reference to file #63 supported by DBIA 2524

 ;

EN ;EP  SCAN AND SPLIT INTO DIVISION,RECORDS

 ;   Build ^XTMP(,,"RECORDS",PSUDIV,L)

 ;   Build ^XTMP(,,"PATIENT",DFN,TEST)=""  AND THEN

 ;                                   ,DATE)=RESULT^FLAG

 K ^XTMP(PSULRSUB,"RECORDS"),^("PATIENTS")

 ;   Gather the tests necessary for each patient

 S PSUDA="" F  S PSUDA=$O(^XTMP(PSULRSUB,"EVENT",PSUDA)) Q:PSUDA'>0  S X=^(PSUDA) D TESTS

 ;

 ;   with the tests gathered for each patient

 ;   now scan each patients daily lab results looking for the tests

 D PATIENT

 Q

TESTS ;EP Gather tests for a patient for the drug class

 ;      nodes used in ^XTMP sampler

 ;^XTMP("PSULR_541074170","CODES","CV800",6) = POTASSIUM

 ;^XTMP("PSULR_541074170","EVENT",1) = IV^599^13^12345^ASPRIN^CV800

 ;^XTMP("PSULR_541074170","PATIENT",13,4) = CREATININE

 ;^XTMP("PSULR_541074170","PATIENT",13,4,7029388.859632) = 1.0^^^50

 ;^XTMP("PSULR_541074170","PATIENT",13,6) = POTASSIUM

 ;^XTMP("PSULR_541074170","PATIENT",13,6,7029388.859632) = 5.0^^^50

 ;

 ; lab test "ch" node locations for each drug class were built in PSULR1 

 ; Setup "Patient",ch node)="" by codes and tests built in XTMP(,,"CODES",TEST node)=test name

 ;

 S PSUDRCD=$P(X,U,6),PSUDFN=$P(X,U,3)

 S PSULRND=0 F  S PSULRND=$O(^XTMP(PSULRSUB,"CODES",PSUDRCD,PSULRND)) Q:PSULRND'>0  S X=^(PSULRND) D

 . S ^XTMP(PSULRSUB,"PATIENT",PSUDFN,PSULRND)=X

 Q

 ;

PATIENT ;EP SCAN for each patient their tests needed

 ;Take   ^XTMP(,"PATIENT","CH TEST NODE")=TESTNAME

 ;scan the lab file

 ;and build

 ;       ^XTMP(,"PATIENT","CH TEST NODE",DATE)=RESULT^TESTFLAG

 ;

 S X1=PSUEDT,X2=-365 D C^%DTC

 ;S X1=PSUSDT,X2=-365 D C^%DTC

 S PSULREDT=9999999-X ; only go back one year

 S PSULRSDT=9999999-PSUSDT

 ;

 ;     gather needed test (nodes) from ^XTMP and put into the X to PSUNODE array

 ;

 S DFN=0 F  K X S DFN=$O(^XTMP(PSULRSUB,"PATIENT",DFN)) Q:DFN'>0  M X=^(DFN) D

 . N PSUNODE

 . ;   psunode("CH" NODE)=test name

 . M PSUNODE=X

 . I '$D(^DPT(DFN,"LR")) Q

 . S PSULRDFN=^DPT(DFN,"LR")

 . S DA=PSULRSDT F  S DA=$O(^LR(PSULRDFN,"CH",DA)) Q:DA'>0  Q:'$D(PSUNODE)  Q:DA>PSULREDT  D

 .. ;  check each date for each ch node in PSUNODE

 .. S Y=0 F  S Y=$O(PSUNODE(Y)) Q:Y'>0  I $D(^LR(PSULRDFN,"CH",DA,Y)) D

 ...  ;found a test, save result & quit testing for the node

 ... I '$P(^LR(PSULRDFN,"CH",DA,0),U,3) Q  ; results not verified

 ... S ^XTMP(PSULRSUB,"PATIENT",DFN,Y,DA)=^LR(PSULRDFN,"CH",DA,Y)

 ... K PSUNODE(Y)

 ;

 Q

 ;

PSULR2    ;BIR/PDW - PBM LAB EXTRACT  PROCESS PATIENTS ;25 AUG 1998

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 +2       ;

 +3       ;DBIA'S

 +4       ; Reference to file #2  supported by DBIA 10035

 +5       ; Reference to file #63 supported by DBIA 2524

 +6       ;

EN        ;EP  SCAN AND SPLIT INTO DIVISION,RECORDS

 +1       ;   Build ^XTMP(,,"RECORDS",PSUDIV,L)

 +2       ;   Build ^XTMP(,,"PATIENT",DFN,TEST)=""  AND THEN

 +3       ;                                   ,DATE)=RESULT^FLAG

 +4        KILL ^XTMP(PSULRSUB,"RECORDS"),^("PATIENTS")

 +5       ;   Gather the tests necessary for each patient

 +6        SET PSUDA=""

           FOR 

               SET PSUDA=$ORDER(^XTMP(PSULRSUB,"EVENT",PSUDA))

               IF PSUDA'>0

                   QUIT 

               SET X=^(PSUDA)

               DO TESTS

 +7       ;

 +8       ;   with the tests gathered for each patient

 +9       ;   now scan each patients daily lab results looking for the tests

 +10       DO PATIENT

 +11       QUIT 

TESTS     ;EP Gather tests for a patient for the drug class

 +1       ;      nodes used in ^XTMP sampler

 +2       ;^XTMP("PSULR_541074170","CODES","CV800",6) = POTASSIUM

 +3       ;^XTMP("PSULR_541074170","EVENT",1) = IV^599^13^12345^ASPRIN^CV800

 +4       ;^XTMP("PSULR_541074170","PATIENT",13,4) = CREATININE

 +5       ;^XTMP("PSULR_541074170","PATIENT",13,4,7029388.859632) = 1.0^^^50

 +6       ;^XTMP("PSULR_541074170","PATIENT",13,6) = POTASSIUM

 +7       ;^XTMP("PSULR_541074170","PATIENT",13,6,7029388.859632) = 5.0^^^50

 +8       ;

 +9       ; lab test "ch" node locations for each drug class were built in PSULR1 

 +10      ; Setup "Patient",ch node)="" by codes and tests built in XTMP(,,"CODES",TEST node)=test name

 +11      ;

 +12       SET PSUDRCD=$PIECE(X,U,6)

           SET PSUDFN=$PIECE(X,U,3)

 +13       SET PSULRND=0

           FOR 

               SET PSULRND=$ORDER(^XTMP(PSULRSUB,"CODES",PSUDRCD,PSULRND))

               IF PSULRND'>0

                   QUIT 

               SET X=^(PSULRND)

               Begin DoDot:1

 +14               SET ^XTMP(PSULRSUB,"PATIENT",PSUDFN,PSULRND)=X

               End DoDot:1

 +15       QUIT 

 +16      ;

PATIENT   ;EP SCAN for each patient their tests needed

 +1       ;Take   ^XTMP(,"PATIENT","CH TEST NODE")=TESTNAME

 +2       ;scan the lab file

 +3       ;and build

 +4       ;       ^XTMP(,"PATIENT","CH TEST NODE",DATE)=RESULT^TESTFLAG

 +5       ;

 +6        SET X1=PSUEDT

           SET X2=-365

           DO C^%DTC

 +7       ;S X1=PSUSDT,X2=-365 D C^%DTC

 +8       ; only go back one year

           SET PSULREDT=9999999-X

 +9        SET PSULRSDT=9999999-PSUSDT

 +10      ;

 +11      ;     gather needed test (nodes) from ^XTMP and put into the X to PSUNODE array

 +12      ;

 +13       SET DFN=0

           FOR 

               KILL X

               SET DFN=$ORDER(^XTMP(PSULRSUB,"PATIENT",DFN))

               IF DFN'>0

                   QUIT 

               MERGE X=^(DFN)

               Begin DoDot:1

 +14               NEW PSUNODE

 +15      ;   psunode("CH" NODE)=test name

 +16               MERGE PSUNODE=X

 +17               IF '$DATA(^DPT(DFN,"LR"))

                       QUIT 

 +18               SET PSULRDFN=^DPT(DFN,"LR")

 +19               SET DA=PSULRSDT

                   FOR 

                       SET DA=$ORDER(^LR(PSULRDFN,"CH",DA))

                       IF DA'>0

                           QUIT 

                       IF '$DATA(PSUNODE)

                           QUIT 

                       IF DA>PSULREDT

                           QUIT 

                       Begin DoDot:2

 +20      ;  check each date for each ch node in PSUNODE

 +21                       SET Y=0

                           FOR 

                               SET Y=$ORDER(PSUNODE(Y))

                               IF Y'>0

                                   QUIT 

                               IF $DATA(^LR(PSULRDFN,"CH",DA,Y))

                                   Begin DoDot:3

 +22      ;found a test, save result & quit testing for the node

 +23      ; results not verified

                                       IF '$PIECE(^LR(PSULRDFN,"CH",DA,0),U,3)

                                           QUIT 

 +24                                   SET ^XTMP(PSULRSUB,"PATIENT",DFN,Y,DA)=^LR(PSULRDFN,"CH",DA,Y)

 +25                                   KILL PSUNODE(Y)

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +26      ;

 +27       QUIT 

 +28      ;