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

BHLV.m

Go to the documentation of this file. 
  1. BHLV ; cmi/flag/maw - BHL IHS Variable Set ; [ 05/22/2002  2:51 PM ]
  1.  ;;3.01;BHL IHS Interfaces with GIS;**1,12,14**;JUN 01, 2002
  1.  ;
  1.  ;setup global variables for IHS HL7 messages
  1.  ;cmi/anch/maw 3/9/2005 added fix for PIMS 5.3 because visit file pointer was moved
  1.  ;cmi/anch/maw 1/4/2006 added fix for visit ien and visit date/time in VST
  1.  ;
  1. MAIN ;EP - this is the main routine driver
  1.  ;I $$BHLIS(BHLMIEN)="X12" D USE,X12 Q
  1.  D USE,EN,OS,OTH
  1.  Q
  1.  ;
  1. USE ;-- setup user variables
  1.  D DUZ^XUP(DUZ)
  1.  D SETDT^UTDT
  1.  S BHLH=$H
  1.  Q
  1.  ;
  1. EN ;-- setup encoding characters
  1.  S FS=$$FIELD^INHUT()
  1.  S CS=$$COMP^INHUT()
  1.  S SCS=$$SUBCOMP^INHUT()
  1.  S RS=$$REP^INHUT()
  1.  S ESC=$E($$ESC^INHUT(),1,1)
  1.  S INA("ENC")=CS_RS_ESC_SCS
  1.  Q
  1.  ;
  1. OS ;-- setup operating system level stuff
  1.  S BHLDOM=$$VAL^XBDIQ1(4.3,1,.01)
  1.  Q
  1.  ;
  1. OTH ;-- setup other variables
  1.  S BHL("IHST")="99IHS"
  1.  Q
  1.  ;
  1. DW1 ;EP - entry point for DW1
  1.  S BHLVIEN=$G(INDA(9000010,1))
  1.  Q
  1.  ;
  1. VST ;EP - get visit date for other segments
  1.  S INDA(2,1)=INDA,BHL("PAT")=INDA
  1.  D ^XBKVAR
  1.  S Y=$G(INDA) D ^AUPNPAT
  1.  I $O(INDA(9000010,0)) S BHL("VIEN")=$G(INDA(9000010,$O(INDA(9000010,0))))  ;maw 3/10/2006
  1.  I '$O(INDA(9000010,0)) D  Q
  1.  . I '$G(INDA(405,1)) S BHL("VDT")=DT Q
  1.  . I '$G(INA("DGPMCA")) S INA("DGPMCA")=$G(INDA(405,1))
  1.  . S BHL("VDTM")=$$VALI^XBDIQ1(405,INA("DGPMCA"),.01)
  1.  . S BHL("VIEN")=""
  1.  . I $$PIMS53() D
  1.  .. S INDA(9000010,1)=$$VALI^XBDIQ1(405,INA("DGPMCA"),.27)
  1.  .. S BHL("VIEN")=$S($G(INDA(405,1)):$$VALI^XBDIQ1(405,INA("DGPMCA"),.27),1:$G(INDA(9000010,$O(INDA(9000010,0)))))
  1.  . I '$$PIMS53() D
  1.  .. S INDA(9000010,1)=$$VALI^XBDIQ1(405,INA("DGPMCA"),9999999.1)
  1.  .. S BHL("VIEN")=$S($G(INDA(405,1)):$$VALI^XBDIQ1(405,INA("DGPMCA"),9999999.1),1:$G(INDA(9000010,$O(INDA(9000010,0)))))
  1.  I '$G(BHL("VDTM")),$G(BHL("VIEN")) S BHL("VDTM")=$$VALI^XBDIQ1(9000010,BHL("VIEN"),.01)
  1.  Q:'$G(BHL("VDTM"))
  1.  S BHL("VDT")=$P(BHL("VDTM"),".")
  1.  Q
  1.  ;
  1. VA200 ;-- check for va 200 conversion if so get provider from there
  1.  I $$VAL^XBDIQ1(9999999.39,1,.22) D  Q
  1.  . S BHLPRV=200
  1.  . S BHLDEAF=.22
  1.  S BHLPROVF=200
  1.  S BHLDEAF=5
  1.  Q
  1.  ;
  1. X12 ;-- X12 setup
  1.  Q
  1.  ;
  1. TZ() ;-- get's time zone differential for current system
  1.  S BHLTZ=$$VALI^XBDIQ1(4.3,1,1)
  1.  I BHLTZ="" Q ""
  1.  S BHLTZD=$$VALI^XBDIQ1(4.4,BHLTZ,2)
  1.  S BHLTZP=$E(BHLTZD,1,1)
  1.  S BHLTZN=$E(BHLTZD,2,999)
  1.  I BHLTZN["." D
  1.  . S BHLTZNA=$P(BHLTZN,".")
  1.  . S BHLTZNB=$P(BHLTZN,".",2)
  1.  . I BHLTZNB=5 S BHLTZNB="30"
  1.  . S BHLTZN=BHLTZNA_BHLTZNB
  1.  S BHLTZLZ=$S($L(BHLTZN)=1:"0",$L(BHLTZN)>2:"0",1:"")
  1.  S BHLTZEZ=$S($L(BHLTZN)>2:"0",1:"00")
  1.  S BHLTZD=BHLTZP_BHLTZLZ_BHLTZN_BHLTZEZ
  1.  S BHLTZD=$E(BHLTZD,1,5)
  1.  Q BHLTZD
  1.  ;
  1. BHLIS(BHLMSG)      ;-- get the interface standard
  1.  S BHLSTD=$$VAL^XBDIQ1(4011,BHLMSG,.11)
  1.  Q BHLSTD
  1.  ;
  1. PIMS53() ;-- check the PIMS version
  1.  N BHLPM
  1.  S BHLPM=$O(^DIC(9.4,"C","PIMS",0))
  1.  I 'BHLPM Q 0
  1.  I $G(^DIC(9.4,BHLPM,"VERSION"))>5.29 Q 1
  1.  Q 0
  1.  ;