BHLSETI.m

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       ;