User bio
404 bio not found
Member since Jun 9, 2016
Posts:
Replies:
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.
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.
//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)
}
}
}
}
}