Routine: BHLAFIN

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

X12 ;-- populate for X12

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

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

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

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

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

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      ;

BHLAFIN.m