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)
}
}
}
}
}
- Log in to post comments