Ryan is an Avid Reader. No contributions for 2024.
Without a doubt, there will be something to
share on the Community in 2025!
User bio
404 bio not found
Member since Jun 9, 2016
Replies:

Thanks for the comments.  Those changes have helped.  Here is the entire routine.  If you see anything else that would help, I'd appreciate the feedback.

uuCLASSLabBBExtract2(Nspace,rNum)
 
 
 //Temporary Global for HID number to code translation
 New $namespace
 ZN Nspace
 SET HID="" 
   FOR
{
    SET HID=$ORDER(^LBI("12H",1,HID),1,VAL)
    QUIT:HID="" 
Set VAL1=$P(VAL,"\",1)
Set ^||site(HID)=VAL1
}

 //Temporary Global for English Text Code translations
 SET TEXTCODE="" 
For
{
      Set TEXTCODE=$ORDER(^LBI(4,TEXTCODE),1,VAL2)
      Quit:TEXTCODE=""
      Set Translation =$P(VAL2,"\",1)
      Set ^||etc(TEXTCODE)=Translation
}
 
 //BB Extract
 
 SET CntIndex=0
 SET PIDX=""    
For
{
  Set PIDX=$ORDER(^LAB(PIDX),1,Data)
Quit:PIDX=""  
Set BBData=$P(Data,"\",6)
If BBData'=""
{
If BBData'="########"
{
Set Name=$P(Data,"\",1)
Set LName=$P(Name,"#",1)
Set FName=$P(Name,"#",2)
Set MIni=$P(Name,"#",3)
Set Name2=LName_","_FName_MIni

Set DOB=$P(Data,"\",2)
Set Year=$E(DOB,5,8)
Set Month=$E(DOB,1,2)
Set Day=$E(DOB,3,4)
Set DOB2=Month_"/"_Day_"/"_Year
 
 
  Set ABO=$P(BBData,"#",1)
  Set Group=$TR($P(ABO,"%",2),"!")                            //Remove "!" from Group (O!,A!)
  Set Rh=$P(ABO,"%",3)
  Set ABO2=Group_" "_Rh
 
 
  Set Units=$P(BBData,"#",2)
 
  Set Trans=$P(BBData,"#",3)
  If Trans '="" Set Trans=$ZDATE(($P(BBData,"#",3))+49307)
 
  Set AgAb=$P(BBData,"#",4)             //Need to create separation between multiple English Text Codes with "-" delimiter
  set temp =""
For codeNum=1:1:$length(AgAb,"-")           // loop through "-" pieces of AgAb
{
set code = $piece(AgAb,"-",codeNum)              // get each code
set $piece(temp," | ",codeNum) = ^||etc(code)          // put the translation into temp using "|" instead of "-"
}
set AgAb = temp                // replace contents of AgAb
 
  Set Prob=$P(BBData,"#",5)
  set temp =""
  For codeNum=1:1:$length(Prob,"-")
  {
set code = $piece(Prob,"-",codeNum)
  set $piece(temp," | ",codeNum) = ^||etc(code)
  }
set Prob = temp
 
  Set Comm=$P(BBData,"#",6)                    //Have to allow for freetext comments (ie. ;269753-;269754-HCC)
  set temp =""
  set first=""
  For codeNum=1:1:$length(Comm,"-")
  {
Set first=$E($piece(Comm,"-",codeNum),1)            //Extract first character of comment
If first=";"                                                                              //Determine if first character is ";"
{set code = $TR($piece(Comm,"-",codeNum),";")}      //Remove the ; from the comment
Else 
{set code = $piece(Comm,"-",codeNum)}               //If no ";", set to itself
  set $piece(temp," | ",codeNum) = ^||etc(code)         //setting temp to muliple pieces with translations
  }
set Comm = temp
 
  Set Attr=$P(BBData,"#",7)
  set temp =""
  For codeNum=1:1:$length(Attr,"-")
  {
set code = $piece(Attr,"-",codeNum)
  set $piece(temp," | ",codeNum) = ^||etc(code)
  }
set Attr = temp
 
  Set EXM=$P(BBData,"#",8)
 
  Set AS=$TR($P(BBData,"#",9),"%")                    //Remove "%" from beginning of code (%POS,%NEG)
 
  Set MRN=""
  For
  {
  Set MRN=$ORDER(^LAB(PIDX,0,"INT","NSP",1,MRN))
Quit:MRN=""

Set HID=""
For
{
Set HID=$ORDER(^LAB(PIDX,0,"INT","NSP",1,MRN,HID))
Quit:HID=""  
 
  IF $P(MRN,"-",2)=""          //Remove any MRNs from list that include "-" (ex. CAP-2313)
 
  {Set CntIndex=CntIndex+1
 Set ^["USER"]SQLLABBBEXTRACT(rNum,CntIndex)=$ListBuild(Name2,MRN,^||site(HID),DOB2,ABO2,AgAb,Prob,Comm,Attr,EXM,AS,Units,Trans)
}   
    }
}
}
}

Certifications & Credly badges:
Ryan has no Certifications & Credly badges yet.
Global Masters badges:
Ryan has no Global Masters badges yet.
Followers:
Ryan has no followers yet.
Following:
Ryan has not followed anybody yet.