BHLAFIN ; cmi/flag/maw - BHL Auto Create Inbound HL7 Fields ;
;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
;;
;
;this routine will auto create inbound HL7 fields and segments for
;GIS based upon the listed version of HL7.
;
MAIN ;-- this is the main routine driver
D SEGARRY
D ASK
Q:'$G(@BHLVER@("MSH"))
D FLDS
Q
;
X12 ;-- populate for X12
Q
;
ASK ;-- ask which version of the HL7 standard
S DIR(0)="S^24:2.4;23:2.3"
S DIR("A")="Build Fields for which version of HL7 "
D ^DIR
Q:$D(DIRUT)
S BHLVER=+Y
S BHLVER="VER"_BHLVER
I '$G(@BHLVER@("MSH")) W !,"Version not supported." Q
K DIR
S DIR(0)="F^1:30",DIR("A")="Use which Prefix for Fields "
D ^DIR
Q:$D(DIRUT)
S BHLPRE=Y
S BHLPRE=BHLPRE
Q
;
FLDS ;-- create the fields here for each segment
S BHLDA=0 F S BHLDA=$O(@BHLVER@(BHLDA)) Q:BHLDA="" D
. S BHLFLDS=$G(@BHLVER@(BHLDA))
. K DD,DO,DIC,Y
. S DIC="^INTHL7S(",DIC(0)="L",X=BHLPRE_" "_BHLDA_" IN"
. S DIC("DR")=".02///"_BHLDA
. D FILE^DICN
. S BHLSEG=+Y
. F BHLI=1:1:BHLFLDS D
.. K DD,DO,Y,DIC
.. S DIC="^INTHL7F(",DIC(0)="L",X=BHLPRE_" "_BHLDA_"-"_BHLI_" IN"
.. S DIC("DR")=".02///STRING;.03///999"
.. D FILE^DICN
.. S BHLFLDE=+Y
.. K DD,DO,Y,DIC
.. D SEGADD
Q
;
SEGADD ;-- add the field to the segment
S DA(1)=BHLSEG
S DIC="^INTHL7S("_BHLSEG_",1,",DIC(0)="L"
S DIC("P")=$P(^DD(4010,1,0),"^",2)
D ^DIC
S BHLSEGE=+Y
K DIE,DR
S DIE=DIC,DA=+Y,DR=".02///"_BHLI
D ^DIE
K DIC,DIE,DR
Q
;
SEGARRY ;-- this is the list of segments
S VER24("MSH")=21
S VER24("EVN")=7
S VER24("PID")=38
S VER23("PID")=38
S VER24("PD1")=21
S VER24("NK1")=37
S VER24("PV1")=52
S VER23("PV1")=52
S VER24("DG1")=19
S VER24("PR1")=18
S VER24("GT1")=55
S VER24("IN1")=49
S VER24("IN2")=72
S VER24("ZP2")=33
S VER24("MRG")=7
S VER23("ORC")=25
S VER23("OBR")=47
S VER23("OBX")=19
Q
;
XARY837 ;-- x12 array
S X1000A("REF")=2
S X1000A("NM1")=9
S X1000A("N2")=1
S X1000A("PER")=8
S X1000B("NM1")=9
S X1000B("N2")=1
S X2000A("HL")=4
S X2000A("PRV")=3
S X2000A("CUR")=2
S X2010AA("NM1")=9
S X2010AA("N2")=1
S X2010AA("N3")=2
S X2010AA("N4")=4
S X2010AA("REF")=2
S X2010AA("REFCC")=2
S X2010AA("PER")=8
S X2010AB("NM1")=9
S X2010AB("N2")=1
S X2010AB("N3")=2
S X2010AB("N4")=4
S X2010AB("REF")=2
S X2000B("HL")=4
S X2000B("SBR")=9
S X2000B("PAT")=9
S X2010BA("NM1")=4
S X2010BA("N2")=1
S X2010BA("N3")=2
S X2010BA("N4")=4
S X2010BA("DMG")=3
S X2010BA("REF")=2
S X2010BA("REFPC")=2
S X2010BB("NM1")=4
S X2010BB("N2")=1
S X2010BB("N3")=2
S X2010BB("N4")=4
S X2010BB("REF")=2
S X2010BC("NM1")=4
S X2010BC("N2")=1
S X2010BC("N3")=2
S X2010BC("N4")=4
S X2010BD("NM1")=4
S X2010BD("N2")=1
S X2010BD("REF")=2
Q
;
BHLAFIN ; cmi/flag/maw - BHL Auto Create Inbound HL7 Fields ;
+1 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
+2 ;;
+3 ;
+4 ;this routine will auto create inbound HL7 fields and segments for
+5 ;GIS based upon the listed version of HL7.
+6 ;
MAIN ;-- this is the main routine driver
+1 DO SEGARRY
+2 DO ASK
+3 IF '$GET(@BHLVER@("MSH"))
QUIT
+4 DO FLDS
+5 QUIT
+6 ;
X12 ;-- populate for X12
+1 QUIT
+2 ;
ASK ;-- ask which version of the HL7 standard
+1 SET DIR(0)="S^24:2.4;23:2.3"
+2 SET DIR("A")="Build Fields for which version of HL7 "
+3 DO ^DIR
+4 IF $DATA(DIRUT)
QUIT
+5 SET BHLVER=+Y
+6 SET BHLVER="VER"_BHLVER
+7 IF '$GET(@BHLVER@("MSH"))
WRITE !,"Version not supported."
QUIT
+8 KILL DIR
+9 SET DIR(0)="F^1:30"
SET DIR("A")="Use which Prefix for Fields "
+10 DO ^DIR
+11 IF $DATA(DIRUT)
QUIT
+12 SET BHLPRE=Y
+13 SET BHLPRE=BHLPRE
+14 QUIT
+15 ;
FLDS ;-- create the fields here for each segment
+1 SET BHLDA=0
FOR
SET BHLDA=$ORDER(@BHLVER@(BHLDA))
IF BHLDA=""
QUIT
Begin DoDot:1
+2 SET BHLFLDS=$GET(@BHLVER@(BHLDA))
+3 KILL DD,DO,DIC,Y
+4 SET DIC="^INTHL7S("
SET DIC(0)="L"
SET X=BHLPRE_" "_BHLDA_" IN"
+5 SET DIC("DR")=".02///"_BHLDA
+6 DO FILE^DICN
+7 SET BHLSEG=+Y
+8 FOR BHLI=1:1:BHLFLDS
Begin DoDot:2
+9 KILL DD,DO,Y,DIC
+10 SET DIC="^INTHL7F("
SET DIC(0)="L"
SET X=BHLPRE_" "_BHLDA_"-"_BHLI_" IN"
+11 SET DIC("DR")=".02///STRING;.03///999"
+12 DO FILE^DICN
+13 SET BHLFLDE=+Y
+14 KILL DD,DO,Y,DIC
+15 DO SEGADD
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
SEGADD ;-- add the field to the segment
+1 SET DA(1)=BHLSEG
+2 SET DIC="^INTHL7S("_BHLSEG_",1,"
SET DIC(0)="L"
+3 SET DIC("P")=$PIECE(^DD(4010,1,0),"^",2)
+4 DO ^DIC
+5 SET BHLSEGE=+Y
+6 KILL DIE,DR
+7 SET DIE=DIC
SET DA=+Y
SET DR=".02///"_BHLI
+8 DO ^DIE
+9 KILL DIC,DIE,DR
+10 QUIT
+11 ;
SEGARRY ;-- this is the list of segments
+1 SET VER24("MSH")=21
+2 SET VER24("EVN")=7
+3 SET VER24("PID")=38
+4 SET VER23("PID")=38
+5 SET VER24("PD1")=21
+6 SET VER24("NK1")=37
+7 SET VER24("PV1")=52
+8 SET VER23("PV1")=52
+9 SET VER24("DG1")=19
+10 SET VER24("PR1")=18
+11 SET VER24("GT1")=55
+12 SET VER24("IN1")=49
+13 SET VER24("IN2")=72
+14 SET VER24("ZP2")=33
+15 SET VER24("MRG")=7
+16 SET VER23("ORC")=25
+17 SET VER23("OBR")=47
+18 SET VER23("OBX")=19
+19 QUIT
+20 ;
XARY837 ;-- x12 array
+1 SET X1000A("REF")=2
+2 SET X1000A("NM1")=9
+3 SET X1000A("N2")=1
+4 SET X1000A("PER")=8
+5 SET X1000B("NM1")=9
+6 SET X1000B("N2")=1
+7 SET X2000A("HL")=4
+8 SET X2000A("PRV")=3
+9 SET X2000A("CUR")=2
+10 SET X2010AA("NM1")=9
+11 SET X2010AA("N2")=1
+12 SET X2010AA("N3")=2
+13 SET X2010AA("N4")=4
+14 SET X2010AA("REF")=2
+15 SET X2010AA("REFCC")=2
+16 SET X2010AA("PER")=8
+17 SET X2010AB("NM1")=9
+18 SET X2010AB("N2")=1
+19 SET X2010AB("N3")=2
+20 SET X2010AB("N4")=4
+21 SET X2010AB("REF")=2
+22 SET X2000B("HL")=4
+23 SET X2000B("SBR")=9
+24 SET X2000B("PAT")=9
+25 SET X2010BA("NM1")=4
+26 SET X2010BA("N2")=1
+27 SET X2010BA("N3")=2
+28 SET X2010BA("N4")=4
+29 SET X2010BA("DMG")=3
+30 SET X2010BA("REF")=2
+31 SET X2010BA("REFPC")=2
+32 SET X2010BB("NM1")=4
+33 SET X2010BB("N2")=1
+34 SET X2010BB("N3")=2
+35 SET X2010BB("N4")=4
+36 SET X2010BB("REF")=2
+37 SET X2010BC("NM1")=4
+38 SET X2010BC("N2")=1
+39 SET X2010BC("N3")=2
+40 SET X2010BC("N4")=4
+41 SET X2010BD("NM1")=4
+42 SET X2010BD("N2")=1
+43 SET X2010BD("REF")=2
+44 QUIT
+45 ;
