Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSULR1

PSULR1.m

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