- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSULR2 2684 printed Feb 18, 2025@23:53:58 Page 2
- 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 ;