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

BHLPV1I.m

Go to the documentation of this file. 
  1. BHLPV1I ; cmi/flag/maw - BHL Process Inbound PV1 Segment ;
  1.  ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
  1.  ;
  1.  ;this routine will file the inbound PV1 segment, it will also
  1.  ;create a visit from the information contained in the segment
  1.  ;we will not modify visits via hl7
  1.  ;
  1. MAIN ;-- this is the main routine driver
  1.  D FILE,EOJ
  1.  Q
  1.  ;
  1. FILE ;-- get the data and file it
  1.  S BHLDA=0 F  S BHLDA=$O(@BHLTMP@(BHLDA)) Q:BHLDA=""!(BHLDA>1)  D
  1.  . S BHLAPLL=$P($G(@BHLTMP@(BHLDA,3)),CS)
  1.  . I BHLAPLL="" S BHLAPLL=$G(@BHLTMP@(BHLDA,39))
  1.  . S BHLAPLL=$O(^AUTTLOC("B",BHLAPLL,0))
  1.  . S (BHLOI,BHLCLN)=$P($G(@BHLTMP@(BHLDA,3)),CS,2)
  1.  . S BHLADMT="DIRECT"
  1.  . ;S BHLATD=$P($G(@BHLTMP@(BHLDA,7)),CS) ; if provider code is passed
  1.  . S BHLATD=$P($G(@BHLTMP@(BHLDA,7)),CS,2)
  1.  . ;I BHLATD'="" S BHLATD=$O(^DIC(6,"GIHS",BHLATD,0)) if prv code is passed
  1.  . ;I BHLATD'="" S BHLATD=$$VAL^XBDIQ1(6,BHLATD,.01) ;if name
  1.  . S BHLCDT=$G(@BHLTMP@(BHLDA,9))
  1.  . S BHLTVIEN=$G(@BHLTMP@(BHLDA,19))  ;visit ien
  1.  . I BHLTVIEN'="" D
  1.  .. S BHLVERR=$$VSTCHK(BHLTVIEN)
  1.  . I $G(BHLVERR) S BHLERCD="NOVMTCH" X BHLERR Q
  1.  . S BHLDD=$G(@BHLTMP@(BHLDA,36))
  1.  . I BHLDD'="" S BHLDD=$$VAL^XBDIQ1(405.1,BHLDD,.01)
  1.  . S BHLADTM=$G(@BHLTMP@(BHLDA,44))
  1.  . S %DT="TX",X=BHLADTM D ^%DT S BHLADTM=Y
  1.  . S BHLDDTM=$G(@BHLTMP@(BHLDA,45))
  1.  . S %DT="TX",X=BHLDDTM D ^%DT S BHLDDTM=Y
  1.  . S BHLDADS=$G(@BHLTMP@(BHLDA,10))
  1.  . S BHLDADS=$S(BHLDADS'="":$O(^DIC(45.7,"B",BHLDADS,0)),1:"")
  1.  . I BHLDADS'="" S BHLDADS=$$VAL^XBDIQ1(45.7,BHLDADS,.01)
  1.  . S BHLDDDS=$G(@BHLTMP@(BHLDA,10))
  1.  . S BHLDDDS=$S(BHLDDDS'="":$O(^DIC(45.7,"B",BHLDDDS,0)),1:"")
  1.  . I BHLDDDS'="" S BHLDDDS=$$VAL^XBDIQ1(45.7,BHLDDDS,.01)
  1.  . I $O(BHL("ZV1",0)) D FILE^BHLZV1I
  1.  . Q:$D(BHLERR("FATAL"))
  1.  . I BHLET="A01" D @BHLET
  1.  . I BHLET="A03" D @BHLET Q
  1.  . I BHLET="A06" D @BHLET
  1.  . I BHLET="A08" D @BHLET
  1.  . I BHLET="A11" D @BHLET Q
  1.  . I BHLAPLL="" S BHLAPLL=DUZ(2)
  1.  . S APCDALVR("APCDDATE")=BHLADTM
  1.  . S APCDALVR("APCDPAT")=BHLPAT
  1.  . S APCDALVR("APCDLOC")=BHLAPLL
  1.  . S APCDALVR("APCDCLN")=BHLCLN
  1.  . D UP
  1.  . Q:$D(BHLERR("FATAL"))
  1.  . I $O(BHL("ZV1",0)) D VF^BHLZV1I
  1.  . D PRV
  1.  Q
  1.  ;
  1. A01 ;-- this is an A01 event, we need to update as current patient
  1.  S BHLCLN=""
  1.  S BHLFL=2,BHLFLD=.1,BHLVAL=BHLDWRD,BHLX=BHLPAT X BHLDIE
  1.  S BHLDSC="H" ;service category
  1.  Q
  1.  ;use the following if we want observations
  1.  I $G(@BHLTMP@(BHLDA,10))="OBSERVATION" D
  1.  . S BHLDSC="O"
  1.  . S BHLCLN=$O(^DIC(40.7,"B","OBSERVATION",0))
  1.  ;admitting diagnosis will be in DG1 segment
  1.  Q
  1.  ;
  1. A03 ;-- add v hosp
  1.  Q:$G(@BHLTMP@(BHLDA,10))="OBSERVATION"
  1.  Q:'$G(APCDALVR("APCDVSIT"))
  1.  S APCDALVR("APCDPAT")=BHLPAT
  1.  S APCDALVR("APCDLOOK")=BHLDDTM
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.02 (ADD)]"
  1.  S APCDALVR("APCDTADS")=BHLDADS
  1.  S APCDALVR("APCDTDCS")=BHLDDDS
  1.  S APCDALVR("APCDTAT")=BHLADMT
  1.  S APCDALVR("APCDTDT")=BHLDD
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S BHLERCD="NOVHOSP" X BHLERR Q
  1.  S BHLFL=2,BHLFLD=.1,BHLVAL="@",BHLX=BHLPAT X BHLDIE
  1.  Q
  1.  ;
  1. A06 ;-- create a hospitalization visit from A06
  1.  S BHLCLN=""
  1.  S BHLFL=2,BHLFLD=.1,BHLVAL=BHLDWRD,BHLX=BHLPAT X BHLDIE
  1.  S BHLDSC="H" ;service category
  1.  I $G(@BHLTMP@(BHLDA,10))="OBSERVATION" D
  1.  . S BHLDSC="O"
  1.  . S BHLCLN=$O(^DIC(40.7,"B","OBSERVATION",0))
  1.  Q
  1.  ;
  1. A08 ;-- just in case they update the patient 
  1.  I $G(@BHLTMP@(BHLDA,10))="OBSERVATION" D
  1.  . S BHLDSC="O"
  1.  . S BHLCLN=$O(^DIC(40.7,"B","OBSERVATION",0))
  1.  Q
  1.  ;
  1. A11 ;-- cancel admit for a patient
  1.  S AUPNVSIT=$O(^AUPNVSIT("AXT",BHLACCT,0))
  1.  Q:AUPNVSIT=""
  1.  S BHLPRIEN=$O(^AUPNVPRV("AD",AUPNVSIT,0))
  1.  Q:BHLPRIEN=""
  1.  S DIK="^AUPNVPRV(",DA=BHLPRIEN D ^DIK
  1.  D DEL^AUPNVSIT
  1.  Q
  1.  ;
  1. UP ;-- this is for an all events except for the A03 event
  1.  S APCDALVR("APCDTYPE")=BHLDVT
  1.  S APCDALVR("APCDCAT")=BHLDSC
  1.  D ^APCDALV
  1.  I $D(APCDAFLG("ERR")) S BHLERCD="NOVST" X BHLERR Q
  1.  S BHLVSIT=APCDALVR("APCDVSIT")
  1.  S BHLFL=9000010,BHLFLD=1211,BHLVAL=BHLACCT,BHLX=BHLVSIT X BHLDIE
  1.  Q
  1.  ;
  1. PRV ;-- let's set up the v provider file
  1.  D PP
  1.  Q:BHLPRV=""
  1.  D CHKV
  1.  Q:$G(BHLMTCH)
  1.  D UPV
  1.  Q
  1.  ;
  1. PP ;-- get the primary provider      
  1.  S BHLPRV=BHLATD
  1.  K BHLMTCH
  1.  Q
  1.  ;
  1. CHKV ;-- check the v provider file
  1.  S BHLVDA=0  F  S BHLVDA=$O(^AUPNVPRV("AD",BHLVSIT,BHLVDA)) Q:BHLVDA=""!$D(BHLMTCH)  D
  1.  . S BHLVPRV=$$VAL^XBDIQ1(6,$P(^AUPNVPRV(BHLVDA,0),U),.01)
  1.  . I BHLVPRV=BHLPRV S BHLMTCH=1
  1.  Q:$D(BHLMTCH)
  1.  Q
  1.  ;
  1. UPV ;-- create the v provider file entry if none exists
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1.  S APCDALVR("APCDTPRO")=BHLATD
  1.  S APCDALVR("APCDTPS")="P"
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S BHLERCD="NOVPRV" X BHLERR Q
  1.  Q
  1.  ;
  1. VSTCHK(VIEN)       ;-- check the visit information to see if match
  1.  I '$D(^AUPNVSIT(VIEN,0)) Q 1
  1.  I $P($G(^AUPNVSIT(VIEN,0)),U,5)'=BHLPAT Q 1
  1.  I $P($G(^AUPNVSIT(VIEN,0)),U)'=BHLEXVDT Q 1
  1.  I $P($G(^AUPNVSIT(VIEN,0)),U,8)'=BHLCLN Q 1
  1.  Q 0
  1.  ;
  1. EOJ ;-- kill variables and quit
  1.  K @BHLTMP
  1.  K BHLAPL,BHLADMT,BHLATD,BHLCDT,BHLDD,BHLDTL,BHLADTM,BHLDDTM,BHLTPB
  1.  K BHLCL,BHLWIA,BHLLVOS,BHLELG,BHLAB,BHLDDS,BHLOL,BHLADS,BHLNOC
  1.  K BHLMREL,BHLAOB,BHLAN,BHLAF,BHLTC,BHLSB,BHLNOV,BHLHVN,BHLVNDR
  1.  K BHLACT,BHLTM,BHLPYS,BHLPRV,BHLVPRV,BHLVDA,BHLPDA,P,BHLCLN
  1.  Q
  1.  ;