Routine: BIMFI

BIMFI ;IHS/CMI/MWR - MFI INTERFACE CODE; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  CODE FOR MFI INTERFACE WITH MACHINES STILL USING OLD IHS CODES.

 ;----------

INBOUND(BIMSG) ;EP

 ;---> Translate Inbound Vaccine carrying Old IHS Code to HL7 Code

 ;---> by scanning Inbound Message and replacing Old IHS Code

 ;---> with HL7 Code.

 ;---> Called by ^APMFPRM.

 ;---> Parameters:

 ;     1 - BIMSG (req) IEN of Inbound Immunization Visit Filegram

 ;                     in ^XMB(3.9.

 Q:$$CHECK(BIMSG)

 N BIN S BIN=1

 F  S BIN=$O(^XMB(3.9,BIMSG,2,BIN)) Q:'BIN  D

 .Q:^XMB(3.9,BIMSG,2,BIN,0)'["BEGIN:IMMUNIZATION^9999999.14"

 .S BIN=BIN+1

 .N BIX S BIX=^XMB(3.9,BIMSG,2,BIN,0)

 .Q:BIX'["KEY:CODE^.03^C="

.;

 .;---> BIOLD=Old IHS Code.

 .N BIOLD S BIOLD=$P(BIX,"=",2)

.;

 .;---> Quit if no match for this IHS Code.

 .Q:'$D(^AUTTIMM("AZ",BIOLD))

.;

 .;---> Set BIDA=IEN of Vaccine, based on Old IHS Code (in X).

 .N BIDA S BIDA=$O(^AUTTIMM("AZ",BIOLD,0))

.;

 .;---> Quit if entry doesn't exist.

 .Q:'$D(^AUTTIMM(BIDA,0))

.;

 .;---> BINEW=New HL7 Code

 .N BINEW S BINEW=$P(^AUTTIMM(BIDA,0),U,3)

 .Q:'BINEW

.;

 .;---> Replace Old IHS Code in Message with New HL7 Code.

 .S $P(^XMB(3.9,BIMSG,2,BIN,0),"=",2)=BINEW

 ;----------

OUTBOUND(BIMSG) ;EP

 ;---> Translate Outbound Vaccine carrying New HL7 Code to

 ;---> Old IHS Code by scanning Outbound Message and replacing

 ;---> HL7 Code with Old IHS Code.

 ;---> Called by ^APMFVFG.

 ;---> Parameters:

 ;     1 - BIMSG (req) IEN of Outbound Immunization Visit Filegram

 ;                     in ^XMB(3.9.

 Q:$$CHECK(BIMSG)

 N BIN S BIN=1

 F  S BIN=$O(^XMB(3.9,BIMSG,2,BIN)) Q:'BIN  D

 .Q:^XMB(3.9,BIMSG,2,BIN,0)'["BEGIN:IMMUNIZATION^9999999.14"

 .S BIN=BIN+1

 .N BIX S BIX=^XMB(3.9,BIMSG,2,BIN,0)

 .Q:BIX'["KEY:HL7 CODE^.03^C="

.;

 .;---> BIOLD=Old IHS Code.

 .N BIHL7 S BIHL7=$P(BIX,"=",2)

.;

 .;---> Quit if no match for this IHS Code.

 .Q:'$D(^AUTTIMM("C",BIHL7))

.;

 .;---> Set BIDA=IEN of Vaccine, based on Old IHS Code (in X).

 .N BIDA S BIDA=$O(^AUTTIMM("C",BIHL7,0))

.;

 .;---> Quit if entry doesn't exist.

 .Q:'$D(^AUTTIMM(BIDA,0))

.;

 .;---> BINEW=Old IHS Code.

 .N BINEW S BINEW=$P(^AUTTIMM(BIDA,0),U,20)

 .Q:BINEW=""

.;

 .;---> Replace New HL7 Code in Message with Old IHS Code.

 .S $P(^XMB(3.9,BIMSG,2,BIN,0),"KEY:",2)="CODE^.03^C="_BINEW

 ;----------

CHECK(BIMSG) ;EP

 ;---> Check required variables.

 ;---> Parameters:

 ;     1 - BIMSG (req) IEN of Immunization Visit Filegram

 ;---> Get Site IEN.

 S BIDUZ2=$G(DUZ(2))

 I 'BIDUZ2 Q:'$G(^AUTTSITE(1,0))  S BIDUZ2=+^(0)

 Q:'BIDUZ2 1

 ;---> Quit if Site Parameter says to send HL7 Standard Codes.

 Q:$P($G(^BISITE(BIDUZ2,0)),U,20) 1

 ;---> Quit if Message does not exist.

 Q:'$D(^XMB(3.9,BIMSG,2)) 1

 ;---> All okay.

Q 0

BIMFI     ;IHS/CMI/MWR - MFI INTERFACE CODE; MAY 10, 2010

 +1       ;;8.5;IMMUNIZATION;;SEP 01,2011

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  CODE FOR MFI INTERFACE WITH MACHINES STILL USING OLD IHS CODES.

 +4       ;

 +5       ;

 +6       ;----------

INBOUND(BIMSG) ;EP

 +1       ;---> Translate Inbound Vaccine carrying Old IHS Code to HL7 Code

 +2       ;---> by scanning Inbound Message and replacing Old IHS Code

 +3       ;---> with HL7 Code.

 +4       ;---> Called by ^APMFPRM.

 +5       ;---> Parameters:

 +6       ;     1 - BIMSG (req) IEN of Inbound Immunization Visit Filegram

 +7       ;                     in ^XMB(3.9.

 +8        IF $$CHECK(BIMSG)

               QUIT

 +9       ;

 +10       NEW BIN

           SET BIN=1

 +11       FOR

               SET BIN=$ORDER(^XMB(3.9,BIMSG,2,BIN))

               IF 'BIN

                   QUIT

               Begin DoDot:1

 +12               IF ^XMB(3.9,BIMSG,2,BIN,0)'["BEGIN

                       QUIT

 +13               SET BIN=BIN+1

 +14               NEW BIX

                   SET BIX=^XMB(3.9,BIMSG,2,BIN,0)

 +15               IF BIX'["KEY

                       QUIT

 +16      ;

 +17      ;---> BIOLD=Old IHS Code.

 +18               NEW BIOLD

                   SET BIOLD=$PIECE(BIX,"=",2)

 +19      ;

 +20      ;---> Quit if no match for this IHS Code.

 +21               IF '$DATA(^AUTTIMM("AZ",BIOLD))

                       QUIT

 +22      ;

 +23      ;---> Set BIDA=IEN of Vaccine, based on Old IHS Code (in X).

 +24               NEW BIDA

                   SET BIDA=$ORDER(^AUTTIMM("AZ",BIOLD,0))

 +25      ;

 +26      ;---> Quit if entry doesn't exist.

 +27               IF '$DATA(^AUTTIMM(BIDA,0))

                       QUIT

 +28      ;

 +29      ;---> BINEW=New HL7 Code

 +30               NEW BINEW

                   SET BINEW=$PIECE(^AUTTIMM(BIDA,0),U,3)

 +31               IF 'BINEW

                       QUIT

 +32      ;

 +33      ;---> Replace Old IHS Code in Message with New HL7 Code.

 +34               SET $PIECE(^XMB(3.9,BIMSG,2,BIN,0),"=",2)=BINEW

               End DoDot:1

 +35       QUIT

 +36      ;

 +37      ;

 +38      ;

 +39      ;----------

OUTBOUND(BIMSG) ;EP

 +1       ;---> Translate Outbound Vaccine carrying New HL7 Code to

 +2       ;---> Old IHS Code by scanning Outbound Message and replacing

 +3       ;---> HL7 Code with Old IHS Code.

 +4       ;---> Called by ^APMFVFG.

 +5       ;---> Parameters:

 +6       ;     1 - BIMSG (req) IEN of Outbound Immunization Visit Filegram

 +7       ;                     in ^XMB(3.9.

 +8        IF $$CHECK(BIMSG)

               QUIT

 +9       ;

 +10       NEW BIN

           SET BIN=1

 +11       FOR

               SET BIN=$ORDER(^XMB(3.9,BIMSG,2,BIN))

               IF 'BIN

                   QUIT

               Begin DoDot:1

 +12               IF ^XMB(3.9,BIMSG,2,BIN,0)'["BEGIN

                       QUIT

 +13               SET BIN=BIN+1

 +14               NEW BIX

                   SET BIX=^XMB(3.9,BIMSG,2,BIN,0)

 +15               IF BIX'["KEY

                       QUIT

 +16      ;

 +17      ;---> BIOLD=Old IHS Code.

 +18               NEW BIHL7

                   SET BIHL7=$PIECE(BIX,"=",2)

 +19      ;

 +20      ;---> Quit if no match for this IHS Code.

 +21               IF '$DATA(^AUTTIMM("C",BIHL7))

                       QUIT

 +22      ;

 +23      ;---> Set BIDA=IEN of Vaccine, based on Old IHS Code (in X).

 +24               NEW BIDA

                   SET BIDA=$ORDER(^AUTTIMM("C",BIHL7,0))

 +25      ;

 +26      ;---> Quit if entry doesn't exist.

 +27               IF '$DATA(^AUTTIMM(BIDA,0))

                       QUIT

 +28      ;

 +29      ;---> BINEW=Old IHS Code.

 +30               NEW BINEW

                   SET BINEW=$PIECE(^AUTTIMM(BIDA,0),U,20)

 +31               IF BINEW=""

                       QUIT

 +32      ;

 +33      ;---> Replace New HL7 Code in Message with Old IHS Code.

 +34               SET $PIECE(^XMB(3.9,BIMSG,2,BIN,0),"KEY:",2)="CODE^.03^C="_BINEW

               End DoDot:1

 +35       QUIT

 +36      ;

 +37      ;

 +38      ;----------

CHECK(BIMSG) ;EP

 +1       ;---> Check required variables.

 +2       ;---> Parameters:

 +3       ;     1 - BIMSG (req) IEN of Immunization Visit Filegram

 +4       ;

 +5       ;---> Get Site IEN.

 +6        SET BIDUZ2=$GET(DUZ(2))

 +7        IF 'BIDUZ2

               IF '$GET(^AUTTSITE(1,0))

                   QUIT

               SET BIDUZ2=+^(0)

 +8        IF 'BIDUZ2

               QUIT 1

 +9       ;

 +10      ;---> Quit if Site Parameter says to send HL7 Standard Codes.

 +11       IF $PIECE($GET(^BISITE(BIDUZ2,0)),U,20)

               QUIT 1

 +12      ;

 +13      ;---> Quit if Message does not exist.

 +14       IF '$DATA(^XMB(3.9,BIMSG,2))

               QUIT 1

 +15      ;

 +16      ;---> All okay.

 +17       QUIT 0

BIMFI.m