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
Q
;
;
;
;----------
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
Q
;
;
;----------
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
