- BHLSETI ; cmi/flag/maw - BHL Setup Incoming Messages ;
- ;;3.01;BHL IHS Interfaces with GIS;**1,16**;JUN 01, 2002
- ;
- ;this routine will drop through the HL7 Message Text File (#772) and
- ;pull the segments into a working area ^TMP("BHLIWRK",$J), it will
- ;then call the appropriate filing routine
- ;
- ;
- MAIN ;-- this is the main routine driver
- D GVARS
- Q
- ;
- GVARS ; setup global variables
- D ^XBKVAR
- S (AGHL7IN,BHLIN)=1 ;flag for other apps to know inbound
- S BHLERR="",BHLCNT=0
- S BHLFS=INDELIM
- S BHLECH=$E(INDELIMS,2,6)
- S FS=BHLFS
- S (BHLCS,CS)=$E(BHLECH,1),(BHLRS,RS)=$E(BHLECH,2)
- S BHLET=$P($G(INV("MSH9")),CS,2)
- S BHL("EVENT DATE")=$G(INV("EVN2"))
- S BHL("EVENT DATE")=$$HDATE^INHUT(BHL("EVENT DATE"),"T")
- S BHLRAP=$G(INV("MSH5"))
- S BHLSAP=$G(INV("MSH3"))
- S BHLSAF=$G(INV("MSH4"))
- S BHLRAF=$G(INV("MSH6"))
- S BHLUIF=$G(UIF)
- S BHLFILE="""^BHL""_BHLR_""I"""
- S BHLH=$H
- S BHLTMP="BHL(BHLR)"
- S BHLSTMP="BHL(BHLR,BHLPAR)"
- S BHLSSTMP="BHL(BHLR,BHLPAR,BHLSPAR)"
- S BHLERR="D TRAP^BHLERR"
- S BHLDIE="D DIE^BHLU"
- S BHLDIE4="D DIE4^BHLU"
- S BHLDIEM="D DIEM^BHLU"
- S BHLXKDIC="K DIC,DD,DO,DA"
- S BHLKW="K BHLERR(""WARNING"")"
- S BHLKSV="K APCDALVR S APCDALVR(""APCDVSIT"")=BHLVSIT,APCDALVR(""APCDPAT"")=BHLPAT"
- S APCDALVR("APCDAUTO")=""
- S APCDALVR("AUPNTALK")=""
- S APCDALVR("APCDANE")=""
- S BHLSITE=$O(^BHLSITE("B",DUZ(2),0))
- Q:$G(BHLNOST) ;quit here when site parameters are not needed
- ;add an error if site parameter file is not setup
- I '$D(^BHLSITE(BHLSITE,0)) S BHLERCD="NOSITE" X BHLERR
- Q:$D(BHLERR("FATAL"))
- S BHLDVT=$S($G(^APCCCTRL(DUZ(2),0)):$P($G(^APCCCTRL(DUZ(2),0)),U,4),1:"I")
- S BHLDSC=$P($G(^BHLSITE(BHLSITE,1)),U,2)
- S BHLDPRV=$P($G(^BHLSITE(BHLSITE,1)),U,3)
- S BHLDLOC=$P($G(^BHLSITE(BHLSITE,1)),U,4)
- S BHLDADMT=$P($G(^BHLSITE(BHLSITE,2)),U)
- S BHLDDDMT=$P($G(^BHLSITE(BHLSITE,2)),U,2)
- S BHLDADS=$P($G(^BHLSITE(BHLSITE,2)),U,3)
- S BHLDDDS=$P($G(^BHLSITE(BHLSITE,2)),U,4)
- S BHLDWRD=""
- Q
- ;
- EOJ ;EP - kill variables
- D EN^XBVK("BHL")
- D EN^XBVK("APCD")
- D EN^XBVK("AUPN")
- K CS,EID,FS,PIEN,RS,SEGCNT,SEX,SSN,VIEN
- K DIC,DR,DOB,AGHL7IN
- Q
- ;
- BHLSETI ; cmi/flag/maw - BHL Setup Incoming Messages ;
- +1 ;;3.01;BHL IHS Interfaces with GIS;**1,16**;JUN 01, 2002
- +2 ;
- +3 ;this routine will drop through the HL7 Message Text File (#772) and
- +4 ;pull the segments into a working area ^TMP("BHLIWRK",$J), it will
- +5 ;then call the appropriate filing routine
- +6 ;
- +7 ;
- MAIN ;-- this is the main routine driver
- +1 DO GVARS
- +2 QUIT
- +3 ;
- GVARS ; setup global variables
- +1 DO ^XBKVAR
- +2 ;flag for other apps to know inbound
- SET (AGHL7IN,BHLIN)=1
- +3 SET BHLERR=""
- SET BHLCNT=0
- +4 SET BHLFS=INDELIM
- +5 SET BHLECH=$EXTRACT(INDELIMS,2,6)
- +6 SET FS=BHLFS
- +7 SET (BHLCS,CS)=$EXTRACT(BHLECH,1)
- SET (BHLRS,RS)=$EXTRACT(BHLECH,2)
- +8 SET BHLET=$PIECE($GET(INV("MSH9")),CS,2)
- +9 SET BHL("EVENT DATE")=$GET(INV("EVN2"))
- +10 SET BHL("EVENT DATE")=$$HDATE^INHUT(BHL("EVENT DATE"),"T")
- +11 SET BHLRAP=$GET(INV("MSH5"))
- +12 SET BHLSAP=$GET(INV("MSH3"))
- +13 SET BHLSAF=$GET(INV("MSH4"))
- +14 SET BHLRAF=$GET(INV("MSH6"))
- +15 SET BHLUIF=$GET(UIF)
- +16 SET BHLFILE="""^BHL""_BHLR_""I"""
- +17 SET BHLH=$HOROLOG
- +18 SET BHLTMP="BHL(BHLR)"
- +19 SET BHLSTMP="BHL(BHLR,BHLPAR)"
- +20 SET BHLSSTMP="BHL(BHLR,BHLPAR,BHLSPAR)"
- +21 SET BHLERR="D TRAP^BHLERR"
- +22 SET BHLDIE="D DIE^BHLU"
- +23 SET BHLDIE4="D DIE4^BHLU"
- +24 SET BHLDIEM="D DIEM^BHLU"
- +25 SET BHLXKDIC="K DIC,DD,DO,DA"
- +26 SET BHLKW="K BHLERR(""WARNING"")"
- +27 SET BHLKSV="K APCDALVR S APCDALVR(""APCDVSIT"")=BHLVSIT,APCDALVR(""APCDPAT"")=BHLPAT"
- +28 SET APCDALVR("APCDAUTO")=""
- +29 SET APCDALVR("AUPNTALK")=""
- +30 SET APCDALVR("APCDANE")=""
- +31 SET BHLSITE=$ORDER(^BHLSITE("B",DUZ(2),0))
- +32 ;quit here when site parameters are not needed
- IF $GET(BHLNOST)
- QUIT
- +33 ;add an error if site parameter file is not setup
- +34 IF '$DATA(^BHLSITE(BHLSITE,0))
- SET BHLERCD="NOSITE"
- XECUTE BHLERR
- +35 IF $DATA(BHLERR("FATAL"))
- QUIT
- +36 SET BHLDVT=$SELECT($GET(^APCCCTRL(DUZ(2),0)):$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4),1:"I")
- +37 SET BHLDSC=$PIECE($GET(^BHLSITE(BHLSITE,1)),U,2)
- +38 SET BHLDPRV=$PIECE($GET(^BHLSITE(BHLSITE,1)),U,3)
- +39 SET BHLDLOC=$PIECE($GET(^BHLSITE(BHLSITE,1)),U,4)
- +40 SET BHLDADMT=$PIECE($GET(^BHLSITE(BHLSITE,2)),U)
- +41 SET BHLDDDMT=$PIECE($GET(^BHLSITE(BHLSITE,2)),U,2)
- +42 SET BHLDADS=$PIECE($GET(^BHLSITE(BHLSITE,2)),U,3)
- +43 SET BHLDDDS=$PIECE($GET(^BHLSITE(BHLSITE,2)),U,4)
- +44 SET BHLDWRD=""
- +45 QUIT
- +46 ;
- EOJ ;EP - kill variables
- +1 DO EN^XBVK("BHL")
- +2 DO EN^XBVK("APCD")
- +3 DO EN^XBVK("AUPN")
- +4 KILL CS,EID,FS,PIEN,RS,SEGCNT,SEX,SSN,VIEN
- +5 KILL DIC,DR,DOB,AGHL7IN
- +6 QUIT
- +7 ;
