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

BHLV01I.m

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