1

おそらく誰かが私を助けることができます。特定の文字列を検索して置換し、リストのいずれかの出現箇所を見つけて、その前にキャリッジ リターンを挿入する必要があります。

サンプル文字列と、問題を解決する試みを提供しています。

サンプル入力:

MSH|^~\&|PCM|A|NSG|A|20120613081122|DoNotBundle|ORM^O01|1133316|P|2.2|||AL|NEPID|1|1234567^PI^PE|345235^ST02A^MR^A~02340395^ST02^PI||HSM^AERHART||19510418000000|F||||||||||1215200001^A|111-22-3333
PV1|1|I|CCU^W207^A^A||||12342^ALI^ROGERS^M^MD^MD|||SUR|||||||16532^ALI^ROGERS^M^MD^MD|INP||B|||||||||||||||||||A|||||20120531145230ORC|PA|11109489^PCM|11109489^PCM|94986|SC||1^Continuous^INDEF^20120613081900^1||20120613081958|RGYIDDER^YIDDER^ROBERT^GSYSTEM ADM^SA||16532^ALI^ROGERS^MMD^MD|CCU||20120613081958|||CCU|RGYIDDER^YIDDER^ROBERT^
G^SYSTEM ADM^SA
OBR|1|11109489^PCM|11109489^PCM|DNR ON^Hard of Hearing^NSG||20120613081122||||||||||16532^ALI^ROGERS^M^MD^MD|||||||||||1^Continuous^INDEF^20120613081900^1

そして私の試み：

$/ = undef;         #tells perl to ignore newlines when reading input
$input = <STDIN>;   #read entire input into $input

$input =~ s/\R/ /g;  #remove all newlines from input. \R matches \r, \n, \r\n

@validSegHdrs = (   "ABS", "ACC", "ADD", "ADJ", "AFF", "AIG", "AIL", "AIP", "AIS", "AL1",
                    "APR", "ARQ", "ACC", "ADD", "ADJ", "AFF", "AIG", "AIL", "AIP", "AIS",
                    "AL1", "APR", "ARQ", "ARV", "AUT", "BHS", "BLC", "BLG", "BPO", "BPX",
                    "BTS", "BTX", "CDM", "CER", "CM0", "CM1", "CM2", "CNS", "CON", "CSP",
                    "CSR", "CSS", "CTD", "CTI", "DB1", "DG1", "DMI", "DRG", "DSC", "DSP",
                    "ECD", "ECR", "EDU", "EQP", "EQU", "ERR", "EVN", "FAC", "FHS", "FT1",
                    "FTS", "GOL", "GP1", "GP2", "GT1", "IAM", "IIM", "ILT", "IN1", "IN2",
                    "IN3", "INV", "IPC", "IPR", "ISD", "ITM", "IVC", "IVT", "LAN", "LCC",
                    "LCH", "LDP", "LOC", "LRL", "MFA", "MFE", "MFI", "MRG", "MSA", "MSH",
                    "NCK", "NDS", "NK1", "NPU", "NSC", "NST", "NTE", "OBR", "OBX", "ODS",
                    "ODT", "OM1", "OM2", "OM3", "OM4", "OM5", "OM6", "OM7", "ORC", "ORG",
                    "OVR", "PCE", "PCR", "PD1", "PDA", "PDC", "PEO", "PES", "PID", "PKG",
                    "PMT", "PR1", "PRA", "PRB", "PRC", "PRD", "PSG", "PSH", "PSL", "PSS",
                    "PTH", "PV1", "PV2", "PYE", "QAK", "QID", "QPD", "QRD", "QRF", "QRI",
                    "RCP", "RDF", "RDT", "REL", "RF1", "RFI", "RGS", "RMI", "ROL", "RQ1",
                    "RQD", "RXA", "RXC", "RXD", "RXE", "RXG", "RXO", "RXR", "SAC", "SCD",
                    "SCH", "SCP", "SDD", "SFT", "SID", "SLT", "SPM", "STF", "STZ", "TCC",
                    "TCD", "TQ1", "TQ2", "TXA", "UAC", "UB1", "UB2", "URD", "URS", "VAR",
                    "VND"
);

foreach (@validSegHdrs) {
    $input =~ s/$_/\r$_/g;
}

print $input;

-

価値のあるものとして、私はHL7で作業しています。HL7 は、それぞれが独自の行にある「セグメント」で構成されています。「MSH」で始まるセグメントは常に最初であり、各追加セグメントの前に改行が必要です。

私の入力では、許可されていないセグメントの途中で改行 (またはキャリッジ リターン) が含まれている可能性があります。また、別のセグメントと同じ行で始まる新しいセグメントに遭遇することもありますが、これも許可されていません。

入力を解析し、最初にすべての改行を取り除き、有効なセグメント ヘッダーの一致を見つけて、それらの前にキャリッジ リターンを挿入するつもりです。すべての有効なセグメント ヘッダーを含む配列を定義し、foreach ループを使用して単純な検索と置換を行い、各一致の前に \r を挿入しようとしています。各文字列と '|' を照合するのは良い考えだと思います。たとえば、'PV1|' で照合します。より正確には。

期待どおりの結果が得られていないため、専門知識をお求めください。どうもありがとう！

4

2 に答える 2

1 
@validSegHdrs = (   "ABS", # .....
);

my $regex = join ("|", @validSegHdrs);
while (<>) {
  s/\R/ /g;
  s/($regex)/\r$1/g;
  print;
}
于 2012-08-20T15:19:30.720 に答える
0

コマンドラインからこのスクリプトを使用しました：

perl -e 'print "\n"; local $/; $in=<>; $in=~s/\R//g; my @blk = qw(ABS ACC ADD ADJ AFF AIG AIL AIP AIS AL1 APR ARQ ACC ADD ADJ AFF AIG AIL AIP AIS AL1 APR ARQ ARV AUT BHS BLC BLG BPO BPX BTS BTX CDM CER CM0 CM1 CM2 CNS CON CSP CSR CSS CTD CTI DB1 DG1 DMI DRG DSC DSP ECD ECR EDU EQP EQU ERR EVN FAC FHS FT1 FTS GOL GP1 GP2 GT1 IAM IIM ILT IN1 IN2 IN3 INV IPC IPR ISD ITM IVC IVT LAN LCC LCH LDP LOC LRL MFA MFE MFI MRG MSA MSH NCK NDS NK1 NPU NSC NST NTE OBR OBX ODS ODT OM1 OM2 OM3 OM4 OM5 OM6 OM7 ORC ORG OVR PCE PCR PD1 PDA PDC PEO PES PID PKG PMT PR1 PRA PRB PRC PRD PSG PSH PSL PSS PTH PV1 PV2 PYE QAK QID QPD QRD QRF QRI RCP RDF RDT REL RF1 RFI RGS RMI ROL RQ1 RQD RXA RXC RXD RXE RXG RXO RXR SAC SCD SCH SCP SDD SFT SID SLT SPM STF STZ TCC TCD TQ1 TQ2 TXA UAC UB1 UB2 URD URS VAR VND); $in=~s/$_/\n$_/ for @blk; print $in, "\n";'

そして、この出力を得ました：

MSH|^~\&|PCM|A|NSG|A|20120613081122|DoNotBundle|ORM^O01|1133316|P|2.2|||AL|NE
PID|1|1234567^PI^PE|345235^ST02A^MR^A~02340395^ST02^PI||HSM^AERHART||19510418000000|F||||||||||1215200001^A|111-22-3333
PV1|1|I|CCU^W207^A^A||||12342^ALI^ROGERS^M^MD^MD|||SUR|||||||16532^ALI^ROGERS^M^MD^MD|INP||B|||||||||||||||||||A|||||20120531145230
ORC|PA|11109489^PCM|11109489^PCM|94986|SC||1^Continuous^INDEF^20120613081900^1||20120613081958|RGYIDDER^YIDDER^ROBERT^GSYSTEM     ADM^SA||16532^ALI^ROGERS^MMD^MD|CCU||20120613081958|||CCU|RGYIDDER^YIDDER^ROBERT^G^SYSTEM     ADM^SA
OBR|1|11109489^PCM|11109489^PCM|DNR ON^Hard of Hearing^NSG||20120613081122||||||||||16532^ALI^ROGERS^M^MD^MD|||||||||||1^Continuous^INDEF^20120613081900^1

スクリプトをインデントして記述した場合、次のようになります。

local $/;
$in=<>;
$in=~s/\R//g;
my @blk = qw(
    ABS ACC ADD ADJ AFF AIG AIL AIP AIS AL1 APR ARQ ACC ADD ADJ AFF AIG AIL AIP
    AIS AL1 APR ARQ ARV AUT BHS BLC BLG BPO BPX BTS BTX CDM CER CM0 CM1 CM2 CNS
    CON CSP CSR CSS CTD CTI DB1 DG1 DMI DRG DSC DSP ECD ECR EDU EQP EQU ERR EVN
    FAC FHS FT1 FTS GOL GP1 GP2 GT1 IAM IIM ILT IN1 IN2 IN3 INV IPC IPR ISD ITM
    IVC IVT LAN LCC LCH LDP LOC LRL MFA MFE MFI MRG MSA MSH NCK NDS NK1 NPU NSC
    NST NTE OBR OBX ODS ODT OM1 OM2 OM3 OM4 OM5 OM6 OM7 ORC ORG OVR PCE PCR PD1
    PDA PDC PEO PES PID PKG PMT PR1 PRA PRB PRC PRD PSG PSH PSL PSS PTH PV1 PV2
    PYE QAK QID QPD QRD QRF QRI RCP RDF RDT REL RF1 RFI RGS RMI ROL RQ1 RQD RXA
    RXC RXD RXE RXG RXO RXR SAC SCD SCH SCP SDD SFT SID SLT SPM STF STZ TCC TCD
    TQ1 TQ2 TXA UAC UB1 UB2 URD URS VAR VND);
$in=~s/$_/\n$_/ for @blk;
print $in, "\n";

を に置き換える\nと\r思います。

私たちのスクリプトの本当の違いが何であるかはわかりませんが、私にとってはうまくいきますか??

ハッシュを使用するとより効率的になる可能性があることに注意してください ( O(n) → O(1) nはヘッダーシーケンスの数です) :

 my %hash = map {$_ => 1} @blk;
 # Test if $1 is a header sequence, if so, print newline
 $in =~ s/( [A-Z0-9]{3} )/ $hash{$1} ? "\n$1" : $1 /xeg;
于 2012-08-20T15:10:52.807 に答える