| 1 | PSULR1 ;BIR/PDW - PBM LAB EXTRACT ;12 AUG 1999
|
|---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|---|
| 3 | ; Extract & setup crosswalk for drug codes and "CH" nodes
|
|---|
| 4 | ; Reference to File # 60 supported by DBIA 2523
|
|---|
| 5 | ; Reference to ^LAM supported by DBIA 2522
|
|---|
| 6 | EN ;EP Tasking Entry Point for generating LAB mail messages, Summaries, & Prints
|
|---|
| 7 | ;
|
|---|
| 8 | CODES ; Table for Building Class * Work Load codes * Lab Tests crosswalk
|
|---|
| 9 | D SETCODES^PSULR0
|
|---|
| 10 | ; Builds ^XTMP(PSULRSUB,"CODES",VA DRUG CLASS,LAB NODE LOCATION)=LAB TEST
|
|---|
| 11 | ; Builds PSUFLAG("BLOOD":"SERUM":"PLASMA") array
|
|---|
| 12 | S:'$D(PSUJOB) PSUJOB=$J
|
|---|
| 13 | S:'$D(PSULRJOB) PSULRJOB=PSUJOB
|
|---|
| 14 | S:'$D(PSULRSUB) PSULRSUB="PSULR_"_PSULRJOB
|
|---|
| 15 | ; Initialize Flag type array
|
|---|
| 16 | F X="BLOOD","SERUM","PLASMA" S PSUFLAG(X)=""
|
|---|
| 17 | ;
|
|---|
| 18 | ; Loop Drug Class Codes & WorkCodes 3.2.8.7
|
|---|
| 19 | S X="AN500" F Y=83405,81062 S PSULRX(X,Y)="" D GET
|
|---|
| 20 | S X="CV200" F Y=82565 S PSULRX(X,Y)="" D GET
|
|---|
| 21 | S X="CV350" F Y=83017,83013,84480,82466,84455,84465 S PSULRX(X,Y)="" D GET
|
|---|
| 22 | S X="CV800" F Y=82565,84140 S PSULRX(X,Y)="" D GET
|
|---|
| 23 | S X="GA301" F Y=82565 S PSULRX(X,Y)="" D GET
|
|---|
| 24 | S X="HS502" F Y=84330,85053,84455,84465,85052 S PSULRX(X,Y)="" D GET
|
|---|
| 25 | ;
|
|---|
| 26 | Q
|
|---|
| 27 | ; Follow wrk code into tests 3.2.8.9
|
|---|
| 28 | GET ;EP Get the appropriate Work Load entry
|
|---|
| 29 | ;
|
|---|
| 30 | S PSUY=Y_".0000 " D WALK
|
|---|
| 31 | F S PSUY=$O(^LAM("C",PSUY)) Q:(+PSUY\1'=+Y) D WALK
|
|---|
| 32 | Q
|
|---|
| 33 | WALK ;EP Do the crosswalk to get the tests associated with workload
|
|---|
| 34 | S Z=$O(^LAM("C",PSUY,0))
|
|---|
| 35 | ; 3.2.8.9
|
|---|
| 36 | I '$D(^LAM(Z,7,"B")) Q
|
|---|
| 37 | ; 3.2.8.10
|
|---|
| 38 | ;
|
|---|
| 39 | S PSUWKDA=Z
|
|---|
| 40 | ; Loop Multiple & Work on over to file 60 & check site/specimen
|
|---|
| 41 | S Z="" F S Z=$O(^LAM(PSUWKDA,7,"B",Z)) Q:Z="" D
|
|---|
| 42 | . S PSULRDA=+Z
|
|---|
| 43 | . K PSUSPECM
|
|---|
| 44 | . D GETM^PSUTL(60,PSULRDA,"100*^.01;6","PSUSPECM")
|
|---|
| 45 | . S DA=0,PSUFLAG=0 F S DA=$O(PSUSPECM(DA)) Q:DA'>0 S W=PSUSPECM(DA,.01) I $D(PSUFLAG(W)) S PSUFLAG=1 Q
|
|---|
| 46 | . Q:'PSUFLAG
|
|---|
| 47 | . ; store DrugCode, WrkCode, Lab IEN = Location
|
|---|
| 48 | . S PSULOC=$$VAL^PSUTL(60,PSULRDA,5),PSULOC=$P(PSULOC,";",2)
|
|---|
| 49 | . ;S ^XTMP(PSULRSUB,"CODES",X,+Y,PSULRDA)=PSULOC ; Trace Construction
|
|---|
| 50 | . S ^XTMP(PSULRSUB,"CODES",X,PSULOC)=$$VAL^PSUTL(60,PSULRDA,.01)_U_PSUSPECM(DA,6)
|
|---|
