BHLV01I ; cmi/sitka/maw - BHL Process V01 Event ;
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;
;
;
MAIN ;-- file the inbound V01 message
D ^BHLSETI
Q:$D(BHLERR("FATAL"))
D QRD,QRF,GET
D EOJ^BHLSETI
Q
;
QRD ;-- get QRD info
S BHLQDTM=$G(INV("QRD1"))
S BHLQID=$G(INV("QRD4"))
S BHLNR=$G(INV("QRD7"))
S BHLWHO=$G(INV("QRD8"))
S BHLQRD2=$G(INV("QRD2"))
S BHLQRD3=$G(INV("QRD3"))
S BHLQRD9=$G(INV("QRD9"))
S BHLQRD12=$G(INV("QRD12"))
D OQRD
Q
;
QRF ;-- get QRF info
S BHLSDT=$G(INV("QRF2"))
I BHLSDT="" S BHLSDT=2000101
S BHLEDT=$G(INV("QRF3"))
I BHLEDT="" S BHLEDT=3990101
S BHLWHOM=$G(INV("QRF5"))
S BHLQRF1=$G(INV("QRF1"))
S BHLQRF6=$G(INV("QRF6"))
S BHLQRF7=$G(INV("QRF7"))
S BHLQRF8=$G(INV("QRF8"))
D OQRF
Q
;
GET ;-- let's lookup the patient then get immunization information
D PTLK^BHLQU
I $G(BHLPAT(2)) D Q
. D QRY^BHLPID
. S X="BHL QUERY RESPONSE MULT",DIC=101 D EN^XQOR
I $G(BHLPAT(1)) S BHLPAT=BHLPAT(1)
I BHLPAT="" D Q
. Q:$G(BHLPAT(1))
. S INA("INSTATIN")="AE"
. S INA("INORIGID")=BHLQID
. S INA("INACKTXT")="Couldn't find patient on system."
. S X="BHL QUERY RESPONSE FAIL",DIC=101 D EN^XQOR
D IMM
Q
;
IMM ;-- lookup immunizations
I '$O(^AUPNVIMM("AC",BHLPAT,0)) D Q
. S INA("INSTATIN")="AE"
. S INA("INORIGID")=BHLQID
. S INA("INACKTXT")="No immunizations listed for this patient"
. S X="BHL QUERY RESPONSE FAIL",DIC=101 D EN^XQOR
S BHLIDA=0 F S BHLIDA=$O(^AUPNVIMM("AC",BHLPAT,BHLIDA)) Q:'BHLIDA D
. S BHLQVST=$P(^AUPNVIMM(BHLIDA,0),U,3)
. S BHLIVST(BHLQVST)=""
D VST
Q
;
VST ;-- pass by visit
S BHLQIV=0 F S BHLQIV=$O(BHLIVST(BHLQIV)) Q:'BHLQIV D
. S BHLIDT=$P($$VALI^XBDIQ1(9000010,BHLQIV,.01),".")
. Q:BHLIDT<BHLSDT
. Q:BHLIDT>BHLEDT
. K INDA
. S BHLQCNT=0
. S INDA(9000010,1)=BHLQIV
. S BHLQVM=0 F S BHLQVM=$O(^AUPNVIMM("AD",BHLQVST,BHLQVM)) Q:'BHLQVM D
.. S BHLQCNT=BHLQCNT+1
.. S INDA(9000010.11,BHLQCNT)=BHLQVM
. S INA("INSTATIN")="AA"
. S INA("INORIGID")=BHLQID
. S INDA=BHLPAT
. S X="BHL QUERY RESPONSE SUCCESS",DIC=101 D EN^XQOR
Q
;
OQRD ;EP - reset the original QRD for passback
S INA("INQDTM")=$G(INV("QRD1"))
S INA("INQPRI")=$G(INV("QRD3"))
S INA("INQTAG")=$G(INV("QRD4"))
S INA("INQWHAT")=$G(INV("QRD9"))
S INA("INQTY")=$G(INV("QRD7"))
S INA("INQWHO")=$G(INV("QRD8"))
Q
;
OQRF ;EP - reset the original QRF for passback
S INA("INQWHERE")=$G(INV("QRF1"))
S INA("INQWHICH")=$G(INV("QRF6"))
S INA("INQSDTM")=$G(INV("QRF2"))
S INA("INQEDTM")=$G(INV("QRF3"))
S INA("INQOSF")=$G(INV("QRF5"))
Q
;
BHLV01I ; cmi/sitka/maw - BHL Process V01 Event ;
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;
+3 ;
+4 ;
MAIN ;-- file the inbound V01 message
+1 DO ^BHLSETI
+2 IF $DATA(BHLERR("FATAL"))
QUIT
+3 DO QRD
DO QRF
DO GET
+4 DO EOJ^BHLSETI
+5 QUIT
+6 ;
QRD ;-- get QRD info
+1 SET BHLQDTM=$GET(INV("QRD1"))
+2 SET BHLQID=$GET(INV("QRD4"))
+3 SET BHLNR=$GET(INV("QRD7"))
+4 SET BHLWHO=$GET(INV("QRD8"))
+5 SET BHLQRD2=$GET(INV("QRD2"))
+6 SET BHLQRD3=$GET(INV("QRD3"))
+7 SET BHLQRD9=$GET(INV("QRD9"))
+8 SET BHLQRD12=$GET(INV("QRD12"))
+9 DO OQRD
+10 QUIT
+11 ;
QRF ;-- get QRF info
+1 SET BHLSDT=$GET(INV("QRF2"))
+2 IF BHLSDT=""
SET BHLSDT=2000101
+3 SET BHLEDT=$GET(INV("QRF3"))
+4 IF BHLEDT=""
SET BHLEDT=3990101
+5 SET BHLWHOM=$GET(INV("QRF5"))
+6 SET BHLQRF1=$GET(INV("QRF1"))
+7 SET BHLQRF6=$GET(INV("QRF6"))
+8 SET BHLQRF7=$GET(INV("QRF7"))
+9 SET BHLQRF8=$GET(INV("QRF8"))
+10 DO OQRF
+11 QUIT
+12 ;
GET ;-- let's lookup the patient then get immunization information
+1 DO PTLK^BHLQU
+2 IF $GET(BHLPAT(2))
Begin DoDot:1
+3 DO QRY^BHLPID
+4 SET X="BHL QUERY RESPONSE MULT"
SET DIC=101
DO EN^XQOR
End DoDot:1
QUIT
+5 IF $GET(BHLPAT(1))
SET BHLPAT=BHLPAT(1)
+6 IF BHLPAT=""
Begin DoDot:1
+7 IF $GET(BHLPAT(1))
QUIT
+8 SET INA("INSTATIN")="AE"
+9 SET INA("INORIGID")=BHLQID
+10 SET INA("INACKTXT")="Couldn't find patient on system."
+11 SET X="BHL QUERY RESPONSE FAIL"
SET DIC=101
DO EN^XQOR
End DoDot:1
QUIT
+12 DO IMM
+13 QUIT
+14 ;
IMM ;-- lookup immunizations
+1 IF '$ORDER(^AUPNVIMM("AC",BHLPAT,0))
Begin DoDot:1
+2 SET INA("INSTATIN")="AE"
+3 SET INA("INORIGID")=BHLQID
+4 SET INA("INACKTXT")="No immunizations listed for this patient"
+5 SET X="BHL QUERY RESPONSE FAIL"
SET DIC=101
DO EN^XQOR
End DoDot:1
QUIT
+6 SET BHLIDA=0
FOR
SET BHLIDA=$ORDER(^AUPNVIMM("AC",BHLPAT,BHLIDA))
IF 'BHLIDA
QUIT
Begin DoDot:1
+7 SET BHLQVST=$PIECE(^AUPNVIMM(BHLIDA,0),U,3)
+8 SET BHLIVST(BHLQVST)=""
End DoDot:1
+9 DO VST
+10 QUIT
+11 ;
VST ;-- pass by visit
+1 SET BHLQIV=0
FOR
SET BHLQIV=$ORDER(BHLIVST(BHLQIV))
IF 'BHLQIV
QUIT
Begin DoDot:1
+2 SET BHLIDT=$PIECE($$VALI^XBDIQ1(9000010,BHLQIV,.01),".")
+3 IF BHLIDT<BHLSDT
QUIT
+4 IF BHLIDT>BHLEDT
QUIT
+5 KILL INDA
+6 SET BHLQCNT=0
+7 SET INDA(9000010,1)=BHLQIV
+8 SET BHLQVM=0
FOR
SET BHLQVM=$ORDER(^AUPNVIMM("AD",BHLQVST,BHLQVM))
IF 'BHLQVM
QUIT
Begin DoDot:2
+9 SET BHLQCNT=BHLQCNT+1
+10 SET INDA(9000010.11,BHLQCNT)=BHLQVM
End DoDot:2
+11 SET INA("INSTATIN")="AA"
+12 SET INA("INORIGID")=BHLQID
+13 SET INDA=BHLPAT
+14 SET X="BHL QUERY RESPONSE SUCCESS"
SET DIC=101
DO EN^XQOR
End DoDot:1
+15 QUIT
+16 ;
OQRD ;EP - reset the original QRD for passback
+1 SET INA("INQDTM")=$GET(INV("QRD1"))
+2 SET INA("INQPRI")=$GET(INV("QRD3"))
+3 SET INA("INQTAG")=$GET(INV("QRD4"))
+4 SET INA("INQWHAT")=$GET(INV("QRD9"))
+5 SET INA("INQTY")=$GET(INV("QRD7"))
+6 SET INA("INQWHO")=$GET(INV("QRD8"))
+7 QUIT
+8 ;
OQRF ;EP - reset the original QRF for passback
+1 SET INA("INQWHERE")=$GET(INV("QRF1"))
+2 SET INA("INQWHICH")=$GET(INV("QRF6"))
+3 SET INA("INQSDTM")=$GET(INV("QRF2"))
+4 SET INA("INQEDTM")=$GET(INV("QRF3"))
+5 SET INA("INQOSF")=$GET(INV("QRF5"))
+6 QUIT
+7 ;
