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