51 lines
2.0 KiB
Mathematica
51 lines
2.0 KiB
Mathematica
PSULR1 ;BIR/PDW - PBM LAB EXTRACT ;12 AUG 1999
|
|
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|
; Extract & setup crosswalk for drug codes and "CH" nodes
|
|
; Reference to File # 60 supported by DBIA 2523
|
|
; Reference to ^LAM supported by DBIA 2522
|
|
EN ;EP Tasking Entry Point for generating LAB mail messages, Summaries, & Prints
|
|
;
|
|
CODES ; Table for Building Class * Work Load codes * Lab Tests crosswalk
|
|
D SETCODES^PSULR0
|
|
; Builds ^XTMP(PSULRSUB,"CODES",VA DRUG CLASS,LAB NODE LOCATION)=LAB TEST
|
|
; Builds PSUFLAG("BLOOD":"SERUM":"PLASMA") array
|
|
S:'$D(PSUJOB) PSUJOB=$J
|
|
S:'$D(PSULRJOB) PSULRJOB=PSUJOB
|
|
S:'$D(PSULRSUB) PSULRSUB="PSULR_"_PSULRJOB
|
|
; Initialize Flag type array
|
|
F X="BLOOD","SERUM","PLASMA" S PSUFLAG(X)=""
|
|
;
|
|
; Loop Drug Class Codes & WorkCodes 3.2.8.7
|
|
S X="AN500" F Y=83405,81062 S PSULRX(X,Y)="" D GET
|
|
S X="CV200" F Y=82565 S PSULRX(X,Y)="" D GET
|
|
S X="CV350" F Y=83017,83013,84480,82466,84455,84465 S PSULRX(X,Y)="" D GET
|
|
S X="CV800" F Y=82565,84140 S PSULRX(X,Y)="" D GET
|
|
S X="GA301" F Y=82565 S PSULRX(X,Y)="" D GET
|
|
S X="HS502" F Y=84330,85053,84455,84465,85052 S PSULRX(X,Y)="" D GET
|
|
;
|
|
Q
|
|
; Follow wrk code into tests 3.2.8.9
|
|
GET ;EP Get the appropriate Work Load entry
|
|
;
|
|
S PSUY=Y_".0000 " D WALK
|
|
F S PSUY=$O(^LAM("C",PSUY)) Q:(+PSUY\1'=+Y) D WALK
|
|
Q
|
|
WALK ;EP Do the crosswalk to get the tests associated with workload
|
|
S Z=$O(^LAM("C",PSUY,0))
|
|
; 3.2.8.9
|
|
I '$D(^LAM(Z,7,"B")) Q
|
|
; 3.2.8.10
|
|
;
|
|
S PSUWKDA=Z
|
|
; Loop Multiple & Work on over to file 60 & check site/specimen
|
|
S Z="" F S Z=$O(^LAM(PSUWKDA,7,"B",Z)) Q:Z="" D
|
|
. S PSULRDA=+Z
|
|
. K PSUSPECM
|
|
. D GETM^PSUTL(60,PSULRDA,"100*^.01;6","PSUSPECM")
|
|
. 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
|
|
. Q:'PSUFLAG
|
|
. ; store DrugCode, WrkCode, Lab IEN = Location
|
|
. S PSULOC=$$VAL^PSUTL(60,PSULRDA,5),PSULOC=$P(PSULOC,";",2)
|
|
. ;S ^XTMP(PSULRSUB,"CODES",X,+Y,PSULRDA)=PSULOC ; Trace Construction
|
|
. S ^XTMP(PSULRSUB,"CODES",X,PSULOC)=$$VAL^PSUTL(60,PSULRDA,.01)_U_PSUSPECM(DA,6)
|