Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BHLEVENT

BHLEVENT.m

Go to the documentation of this file. 
  1. BHLEVENT ; cmi/flag/maw - BHL Events ;  [ 09/24/2004  12:39 PM ]
  1.  ;;3.01;BHL IHS Interfaces with GIS;**2,11,12,13,14,15,16,17**;OCT 15, 2002
  1.  ;
  1.  ;
  1.  ;cmi/anch/maw 3/30/2007 added DW1MRG for merge record in Data Warehouse GIS Patch 15
  1.  ;cmi/anch/maw 5/29/2007 modified O01 to look for BHL("ALTDUZ2")
  1.  ;cmi/anch/maw 3/04/2009 modified O01 for ref lab enhancements
  1.  ;
  1.  ;this routine will contain entry points from various applications
  1.  ;that are event based. (ie. admits, discharges, visits, etc.)
  1.  ;It will then call the appropriate application.
  1.  Q  ;not callable from top
  1.  ;
  1. GIS ;-- the following are GIS calls by HL7 events
  1.  Q  ;not callable at GIS
  1.  ;
  1. A01(BHLPAT,BHLDGPMC,BHLVAIN,BHLADT) ;PEP - this is an admit event
  1.  ;called from ADGCALLS
  1.  S BHLVST=$$VALI^XBDIQ1(405,BHLDGPMC,9999999.1)
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST,INDA(405,1)=BHLDGPMC
  1.  S INA("DGPMCA")=$G(BHLDGPMC)
  1.  S INA("ADMPHY")=$P($G(BHLVAIN(2)),U)
  1.  S INA("FTS")=$P($G(BHLVAIN(3)),U,2)
  1.  D ^INHF("HL IHS A01 OUT PARENT",.INDA,.INA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. A02(BHLPAT,BHLDGPMC,BHLVAIN,BHLADT) ;PEP - this is a transfer event
  1.  ;called from ADGCALLS, ADGEVNT
  1.  S BHLVST=$$VALI^XBDIQ1(405,BHLDGPMC,9999999.1)
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST,INDA(405,1)=BHLDGPMC
  1.  S INA("DGPMCA")=$G(BHLDGPMC)
  1.  S INA("ADMPHY")=$P($G(BHLVAIN(2)),U)
  1.  S INA("FTS")=$P($G(BHLVAIN(3)),U,2)
  1.  D ^INHF("HL IHS A02 OUT PARENT",.INDA,.INA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. A03(BHLPAT,BHLDGPMC,BHLVAIN,BHLADT) ;PEP - this is a discharge event
  1.  ;called from ADGCALLS
  1.  S BHLVST=$$VALI^XBDIQ1(405,BHLDGPMC,9999999.1)
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST,INDA(405,1)=BHLDGPMC
  1.  S INA("DGPMCA")=$G(BHLDGPMC)
  1.  S INA("ADMPHY")=$P($G(BHLVAIN(2)),U)
  1.  S INA("FTS")=$P($G(BHLVAIN(3)),U,2)
  1.  D ^INHF("HL IHS A03 OUT PARENT",.INDA,.INA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. A04(BHLVST)        ;PEP - this is a visit checkin event
  1.  ;called from Scheduling Protocol
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVSIT(BHLVST,0)),U,5)
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("HL IHS A04 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. A08(BHLVST)        ;PEP - this is a visit update event
  1.  ;called from AUPNVSIT
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVSIT(BHLVST,0)),U,5)
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("HL IHS A08 (VISIT) OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. A28(BHLPAT)         ;PEP - this is a new patient entered into the system
  1.  ;called from AG0
  1.  S INDA=BHLPAT
  1.  D ^INHF("HL IHS A28 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. A31(BHLPAT)         ;PEP - this is a patient registration update in the system
  1.  ;called from AG1, AGED
  1.  S INDA=BHLPAT
  1.  D ^INHF("HL IHS A31 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. O01(BHL) ;PEP - Order Message
  1.  K INDA,INA
  1.  I '$G(BHL("PAT")) Q $$MSG(0)
  1.  S INDA=BHL("PAT")
  1.  S INA("DUZ2")=$S($G(BHL("ALTDUZ2")):BHL("ALTDUZ2"),1:DUZ(2))  ;cmi/maw 4/25/2006 DUZ(2) gets reset by GIS
  1.  ;cmi/maw 4/25/2006 changed below code due to lapcorp inadequacy
  1.  I BHL("RLE")'="LABCORP" S INA("SF")=$G(BHL("CLIENT")) ;maw 3/3/2006 dynamic account number in MSH
  1.  S INA("PID20LABO",1)=$G(BHL("CLIENT"))_"^^^"_$S($E($G(BHL("BILL TYPE")),1,1)="T":$G(BHL("INSTYP")),$E($G(BHL("BILL TYPE")),1,1)="P":"P",1:"C")  ;quest client id
  1.  I BHL("RLE")="LABCORP" S INA("PID20LABO",1)=$G(BHL("CLIENT"))_"^^^"_$S($E($G(BHL("BILL TYPE")),1,1)="T":"T",$E($G(BHL("BILL TYPE")),1,1)="P":"P",1:"C")  ;labcorp client id
  1.  S INA("ORC2LABO")=$G(BHL("UID"))
  1.  S INA("ORC12LABO")=$G(BHL("ORDP"))
  1.  S INA("ORC11LABO")=$$DATE^INHUT($G(BHL("CDT")),1)
  1.  S BHLDA=0 F  S BHLDA=$O(BHL(BHLDA)) Q:'BHLDA  D
  1.  . S INA("ORC2LABO",BHLDA)=$G(BHL("UID"))
  1.  . S INA("ORC11LABO",BHLDA)=$G(BHL(BHLDA,"CDT"))
  1.  . S INA("ORC12LABO",BHLDA)=$G(BHL(BHLDA,"ORDP"))
  1.  . S INA("OBR4LABO",BHLDA)=U_U_U_$G(BHL(BHLDA,"TCNM"))
  1.  . S INA("OBR4LABOL",BHLDA)=$G(BHL(BHLDA,"TCNM"))
  1.  . S INA("OBR7LABO",BHLDA)=$G(BHL(BHLDA,"CDT"))
  1.  . S INA("OBR13LABO",BHLDA)="N"
  1.  . S INA("OBR15LABO",BHLDA)=$G(BHL(BHLDA,"SRC"))
  1.  . S INA("OBR18LC",BHLDA)=$G(BHL(BHLDA,"ORD"))
  1.  . S INA("OBR27LABO",BHLDA)=""
  1.  . N IDA
  1.  . S IDA=0 F  S IDA=$O(BHL(BHLDA,"INSE",IDA)) Q:'IDA  D
  1.  .. S INDA("IN1",IDA)=""
  1.  .. S INA("IN13LABO",IDA)=$S($G(BHL("RLE"))="LABCORP":U_$G(BHL(BHLDA,"INSID",IDA)),1:$G(BHL(BHLDA,"INSID",IDA)))
  1.  .. S INA("IN14LABO",IDA)=$G(BHL(BHLDA,"INSE",IDA))
  1.  .. S INA("IN15LABO",IDA)=$G(BHL(BHLDA,"INSADD",IDA))
  1.  .. S INA("IN17LABO",IDA)=$G(BHL(BHLDA,"INSPHO",IDA))
  1.  .. S INA("IN18LABO",IDA)=$G(BHL(BHLDA,"INSGRP",IDA))
  1.  .. S INA("IN111LABO",IDA)=$G(BHL(BHLDA,"INSEMP",IDA))
  1.  .. S INA("IN112LABO",IDA)=$$DATE^INHUT($G(BHL(BHLDA,"INSELG",IDA)),1)
  1.  .. S INA("IN113LABO",IDA)=$$DATE^INHUT($G(BHL(BHLDA,"INSEXP",IDA)),1)
  1.  .. S INA("IN115LABO",IDA)=$G(BHL(BHLDA,"INSPLN",IDA))
  1.  .. S INA("IN116LABO",IDA)=$G(BHL(BHLDA,"INSNOI",IDA))
  1.  .. S INA("IN117LABO",IDA)=$G(BHL(BHLDA,"INSREL",IDA))
  1.  .. S INA("IN119LABO",IDA)=$G(BHL(BHLDA,"INSADD",IDA))
  1.  .. S INA("IN136LABO",IDA)=$G(BHL(BHLDA,"INSPOL",IDA))
  1.  .. S INA("IN147LABO",IDA)=$S($G(BHL(BHLDA,"INSCOV",IDA))]"":$E(BHL(BHLDA,"INSCOV",IDA),1,1),1:"C")
  1.  . S INA("GT13LABO",BHLDA)=$G(BHL(BHLDA,"GT1NM"))
  1.  . S INA("GT15LABO",BHLDA)=$G(BHL(BHLDA,"GT1ADD"))
  1.  . S INA("GT16LABO",BHLDA)=$G(BHL(BHLDA,"GT1PHO"))
  1.  . ;cmi/maw 4/4/2008 end of insurance info
  1.  . ;cmi/maw 4/4/2008 beginning of dx
  1.  . S INA("GT13LABO")=$G(BHL(BHLDA,"GT1NM"))
  1.  . S INA("GT15LABO")=$G(BHL(BHLDA,"GT1ADD"))
  1.  . S INA("GT16LABO")=$G(BHL(BHLDA,"GT1PHO"))
  1.  . ;cmi/maw 4/4/2008 end of insurance info
  1.  . ;cmi/maw 4/4/2008 beginning of dx
  1.  . N DGDA
  1.  . S DGDA=0 F  S DGDA=$O(BHL(BHLDA,"DX",DGDA)) Q:'DGDA  D
  1.  .. S INDA("DG1",DGDA)=""
  1.  .. S INA("DG13LABO",DGDA)=$G(BHL(BHLDA,"DX",DGDA))
  1.  .. S INA("DG14LABO",DGDA)=$G(BHL(BHLDA,"DXE",DGDA))
  1.  .. S INA("DG13LABO")=$G(BHL(BHLDA,"DX",DGDA))
  1.  .. S INA("DG14LABO")=$G(BHL(BHLDA,"DXE",DGDA))
  1.  . ;cmi/maw 4/4/2008 end of dx 
  1.  . S INDA("ORC",BHLDA)=""
  1.  . S INDA("OBR",BHLDA)=""
  1.  . S BHLCDA=0 F  S BHLCDA=$O(BHL(BHLDA,"COMMENT",BHLCDA)) Q:'BHLCDA  D
  1.  .. S INDA("OBX",BHLCDA)=""
  1.  .. S BHLCOM1=$P(BHL(BHLDA,"COMMENT",BHLCDA),U)
  1.  .. S BHLCOM2=$P(BHL(BHLDA,"COMMENT",BHLCDA),U,2)
  1.  .. S BHLCOM3=$P(BHL(BHLDA,"COMMENT",BHLCDA),U,3)
  1.  .. S INA("OBX3LABO",BHLDA,BHLCDA)=U_U_U_BHLCOM1_U_BHLCOM2
  1.  .. S INA("OBX2LABOL",BHLDA,BHLCDA)="ST"
  1.  .. S INA("OBX3LABOL1",BHLDA,BHLCDA)=BHLCOM1
  1.  .. S INA("OBX3LABOL2",BHLDA,BHLCDA)=BHLCOM2
  1.  .. S INA("OBX14LABO",BHLDA,BHLCDA)=$G(BHL("CDT"))
  1.  .. S INA("OBX5LABO",BHLDA,BHLCDA)=BHLCOM3
  1.  .. S INA("OBX3LABLC3",BHLDA,BHLCDA)=$G(BHL("RLE"))
  1.  S INA("ORC2LABO")=$G(BHL("UID"))
  1.  S INA("ORC11LABO")=$G(BHL("CDT"))
  1.  S INA("ORC12LABO")=$G(BHL("ORDP"))
  1.  S INA("OBR4LABO")=U_U_U_$G(BHL("TCNM"))
  1.  S INA("OBR4LABOL")=$G(BHL("TCNM"))
  1.  S INA("OBR7LABO")=$G(BHL("CDT"))
  1.  S INA("OBR13LABO")="N"
  1.  S INA("OBR27LABO")=""
  1.  S INDA("ORC")=""
  1.  S INDA("OBR")=""
  1.  S BHLCDA=0 F  S BHLCDA=$O(BHL("COMMENT",BHLCDA)) Q:'BHLCDA  D
  1.  . S INDA("OBX",BHLCDA)=""
  1.  . S BHLCOM1=$P(BHL("COMMENT",BHLCDA),U)
  1.  . S BHLCOM2=$P(BHL("COMMENT",BHLCDA),U,2)
  1.  . S BHLCOM3=$P(BHL("COMMENT",BHLCDA),U,3)
  1.  . S INA("OBX2LABOL",BHLCDA)="ST"
  1.  . S INA("OBX3LABOL1",BHLCDA)=BHLCOM1
  1.  . S INA("OBX3LABOL2",BHLCDA)=BHLCOM2
  1.  . S INA("OBX14LABO",BHLCDA)=$G(BHL("CDT"))
  1.  . S INA("OBX3LABO",BHLCDA)=U_U_U_BHLCOM1_U_BHLCOM2
  1.  . S INA("OBX5LABO",BHLCDA)=BHLCOM3
  1.  . S INA("OBX3LABLC3",BHLCDA)=$G(BHL("RLE"))
  1.  D ^INHF("HL IHS O01 OUT PARENT",.INDA,.INA)
  1.  Q $$MSG(INHF)
  1.  ;
  1. O01J(INDA) ;PEP - joslin event
  1.  I '$G(INDA) Q $$MSG("PAT")
  1.  ;D ^INHF("HL IHS JVN PACS O01 OUT PARENT",.INDA)
  1.  S INA("SENDING FACILITY")=$G(DUZ(2)) ;JOSLIN/TUC/JLM 01/03/06
  1.  D ^INHF("HL IHS JVN PACS O01 OUT PARENT",.INDA,.INA) ;JOSLIN/TUC/JLM 01/03/06
  1.  ;This was changed to accommodate multiple facilities on the same UCI.
  1.  Q $$MSG(INHF)
  1.  ;
  1. O13(BHLVST)         ;PEP - this is a medication dispense event
  1.  ;called from APSPCCK1,APSPCCN,APSPCCR,APSPVST1
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVSIT(BHLVST,0)),U,5)
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("HL IHS O13 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG("INHF")
  1.  ;
  1. R01(BHLVST)      ;PEP - this is the call that generates a generic result msg
  1.  S BHLVST=$P($G(^AUPNVLAB(BHLVLAB,0)),U,3)
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVLAB(BHLVLAB,0)),U,2)
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  S INDA(9000010.09,1)=BHLVLAB
  1.  D ^INHF("HL IHS R01 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. R01SS(BHLVLAB)      ;PEP - this is the call that generates the lab result message
  1.  ;called from BLSLX
  1.  I 'BHLVLAB Q $$MSG("VLAB")
  1.  S BHLVST=$P($G(^AUPNVLAB(BHLVLAB,0)),U,3)
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVLAB(BHLVLAB,0)),U,2)
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  S INDA(9000010.09,1)=BHLVLAB
  1.  D ^INHF("HL IHS R01 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. V04(BHLVST)        ;PEP - this is the unsolicited Imm record
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVSIT(BHLVST,0)),U,5)
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("HL IHS V04 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $$MSG("INHF")
  1.  ;
  1. MFN(BHLMFL,BHLIEN)   ;PEP - this will pass an update from the file passed in
  1.  ;for IHS EMPI per George Huggins 12/20/2001
  1.  I 'XPMFL Q $$MSG("MFL")
  1.  S INDA=BHLIEN
  1.  S INDA(BHLMFL,1)=BHLIEN
  1.  D ^INHF("HL IHS MFN OUT PARENT",.INDA)
  1.  Q $$MSG(INHF)
  1.  ;
  1. ELG(BHLPAT,BHLVST,INA)       ;PEP - x12 270 call from AGEVC routine
  1.  ;called from AGEVC
  1.  S BHLMSTD="X12"
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("X1 IHS 270 OUT PARENT",.INDA,.INA)
  1.  I 'INHF Q $$MSG(0)
  1.  S BHLUIF=$O(^INTHU("AT",INHF,0))
  1.  Q $$MSG(INHF)  ;only use remaining code if writing to file
  1.  I 'BHLUIF D
  1.  . D CHK^BHLBCK($O(^INTHPC("B","FORMAT CONTROLLER",0)))
  1.  . H 5
  1.  . S BHLUIF=$O(^INTHU("AT",INHF,0))
  1.  I 'BHLUIF Q $$MSG(0)
  1.  S BHLFLNM=$P($G(^INTHU(BHLUIF,0)),U,5)
  1.  D HFS^BHLU(BHLFLNM,BHLUIF)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. ELGS(BHLPAT,BHLVST,INA)       ;PEP - x12 270 subscriber call from AGEVC routine
  1.  ;called from AGEVC
  1.  S BHLMSTD="X12"
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("X1 IHS 270 SUBSCRIBER OUT PARENT",.INDA,.INA)
  1.  I 'INHF Q $$MSG(0)
  1.  Q $$MSG(INHF)  ;only use remaining code if writing to file
  1.  S BHLUIF=$O(^INTHU("AT",INHF,0))
  1.  I 'BHLUIF D
  1.  . D CHK^BHLBCK($O(^INTHPC("B","FORMAT CONTROLLER",0)))
  1.  . H 5
  1.  . S BHLUIF=$O(^INTHU("AT",INHF,0))
  1.  I 'BHLUIF Q $$MSG(0)
  1.  S BHLFLNM=$P($G(^INTHU(BHLUIF,0)),U,5)
  1.  D HFS^BHLU(BHLFLNM,BHLUIF)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. THREEM(BHLVST,BHLIP)      ;PEP - 3m Event Caller
  1.  ;called from APCD3M
  1.  I '$D(^AUPNVSIT(BHLVST,0)) Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVSIT(BHLVST,0)),U,5)
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("HL IHS A08 OUT 3M P "_BHLIP,.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. 837(BHLCLM,BHLSTOR)         ;-- test global array
  1.  S INA("STORAGE")=BHLSTOR
  1.  I '$G(BHLCLM) Q $$MSG(0)
  1.  S INDA=BHLCLM
  1.  D ^INHF("X1 IHS 837 OUT PARENT "_BHLINA,INDA,.INA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. 276(BHLINDA,BHLINA)         ;-- send a claim status
  1.  I '$D(^BARECLST(BHLINDA,0)) Q $$MSG(0)
  1.  S INDA=BHLINDA
  1.  D ^INHF("X1 IHS 276 PARENT "_BHLINA("DEST"),INDA,.BHLINA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. 278(BHLDUZ2,BHLINDA,BHLINA)         ;-- send a referral request
  1.  I '$D(^ACHSF(BHLDUZ2,0)) Q $$MSG(0)
  1.  I '$D(^ACHSF(BHLDUZ2,"D",BHLINDA)) Q $$MSG(0)
  1.  S INDA=BHLINDA
  1.  D ^INHF("X1 IHS 278 OUT PARENT "_BHLINA("DEST"),INDA,.BHLINA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;
  1. DW1HDR(FILENUM,FIEN)         ;-- generate the message header for the batch
  1.  S INDA=FIEN
  1.  S INA("FILE")=FILENUM
  1.  D ^INHF("HL IHS DW1 HDR OUT PARENT",.INDA,.INA)
  1.  Q $P($$MSG(INHF),U)
  1.  ;
  1. DW1TRLR(FILENUM,FIEN)        ;-- generate the trailer for the batch
  1.  S INDA=FIEN
  1.  S INA("FILE")=FILENUM
  1.  D ^INHF("HL IHS DW1 TRL OUT PARENT",.INDA,.INA)
  1.  Q $P($$MSG(INHF),U)
  1.  ;
  1. DW1REG(BHLPAT,INA) ;-- generate a reg update for dw1
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  I $G(INA) S INA("BACKLOAD")=1
  1.  D ^INHF("HL IHS DW1 A31 OUT PARENT",.INDA,.INA)
  1.  D EOJ
  1.  Q $P($$MSG(INHF),U)
  1.  ;
  1. DW1A08(BHLVST)     ;-- generate a visit update for dw1
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVSIT(BHLVST,0)),U,5)
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("HL IHS DW1 A08 OUT PARENT",.INDA)
  1.  D EOJ
  1.  Q $P($$MSG(INHF),U)
  1.  ;
  1. DW1MRG(BHLPAT,INA) ;-- generate a reg update for dw1
  1.  ;cmi/anch/maw 3/30/2007 added for merge record patch 15
  1.  I 'BHLPAT Q $$MSG("PAT")
  1.  S INDA=BHLPAT
  1.  I $G(INA) S INA("BACKLOAD")=1
  1.  D ^INHF("HL IHS DW1 A40 OUT PARENT",.INDA,.INA)
  1.  D EOJ
  1.  Q $P($$MSG(INHF),U)
  1.  ;
  1. BCDM(BHLVST,INA) ;-- generate a visit record for BCDM
  1.  S INDA=BHLVST
  1.  D ^INHF("HL IHS CDMP OUT (PARENT)",.INDA,.INA)
  1.  D EOJ
  1.  Q $P($$MSG(INHF),U)
  1.  ;
  1. BCDMMED(BHLVST,INA)         ;PEP - this is a medication dispense event
  1.  ;called from BCDMSNDR
  1.  I 'BHLVST Q $$MSG("VST")
  1.  S BHLPAT=$P($G(^AUPNVSIT(BHLVST,0)),U,5)
  1.  S INDA=BHLPAT
  1.  S INDA(9000010,1)=BHLVST
  1.  D ^INHF("HL IHS CDMP O13 OUT PARENT",.INDA,.INA)
  1.  D EOJ
  1.  Q $$MSG("INHF")
  1.  ;
  1. EOJ ;-- kills variables
  1.  K INDA,BHLPAT,BHLVST,BHLDGPMC,BHLVAIN,BHLADT
  1.  Q
  1.  ;
  1. MSG(BHLMVAR)        ;-- return message defining status
  1.  I BHLMVAR="PAT" S BHLRMSG="Patient Not Passed In, Message Not Created"
  1.  I BHLMVAR="VST" S BHLRMSG="Visit Not Passed In, Message Not Created"
  1.  I BHLMVAR="VLAB" S BHLRMSG="VLAB Not Passed In, Message Not Created"
  1.  I BHLMVAR="MFL" S BHLRMSG="Mstr File Not Passed In, Message Not Created"
  1.  I BHLMVAR=0 S BHLRMSG="Message Not Created, problem with GIS call"
  1.  I BHLMVAR S BHLRMSG=BHLMVAR_U_"Message Created Successfully"
  1.  Q $G(BHLRMSG)
  1.  ;