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

IBCNHHLO.m

Go to the documentation of this file.
  1. IBCNHHLO ;ALB/ZEB - HL7 Sender for NIF transmissions ;25-FEB-14
  1. ;;2.0;INTEGRATED BILLING;**519,521**;21-MAR-94;Build 33
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;**Program Description**
  1. ; This program will process outgoing NIF query messages.
  1. ; Call at tags only
  1. Q
  1. ;IB*2.0*521/ZEB: Used new $$CLEAN function to remove HL7 delimiters from free-text fields
  1. SEND(INSCO) ;INSCO: IEN of Insurance Company record to send
  1. Q:+$P($G(^IBE(350.9,1,70)),U,1)'=1 ;abort if secret HL7 flag isn't set
  1. K HLA,HLEVN
  1. N CNT,HL,HLFS,HLCS,HLRS,LN,INS,HLRSLT,HLCS11,HLCSCNT,TOC,PHN,HLCS4
  1. S CNT=0
  1. ;set up environment for message
  1. D INIT^HLFNC2("IB NIF QUERY DRIVER",.HL)
  1. S HLFS=$G(HL("FS")) I HLFS="" S HLFS="|"
  1. S HLCS=$E(HL("ECH"),1)
  1. S HLCS4=HLCS
  1. F HLCSCNT=1:1:3 S HLCS4=HLCS4_HLCS
  1. S HLCS11=HLCS4
  1. F HLCSCNT=1:1:7 S HLCS11=HLCS11_HLCS
  1. S HLRS=$E(HL("ECH"),2)
  1. D R36^IBCNHUT2(INSCO,.INS) ;get info from ins. co. record
  1. ;Add message txt to HLA array
  1. ; add QPD segment
  1. S CNT=CNT+1,HLA("HLS",CNT)="QPD"_HLFS_"ZHPID01"_HLCS_"HPID Insurance Inquiry"
  1. ; add an empty RCP segment
  1. S CNT=CNT+1,HLA("HLS",CNT)="RCP"_HLFS_"I"
  1. ; add IN1 segment
  1. S LN=0
  1. S CNT=CNT+1,HLA("HLS",CNT)="IN1"_HLFS
  1. S LN=LN+1,HLA("HLS",CNT,LN)="0001"_HLFS_"VA"_HLCS_"Department of Veterans Affairs"_HLFS
  1. S LN=LN+1,HLA("HLS",CNT,LN)=$P($$SITE^VASITE,U,3)_"."_INSCO_HLCS4_"INS"
  1. I $P(INS(2),U,1)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,1))_HLCS4_"PROF"
  1. I $P(INS(2),U,2)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,2))_HLCS4_"INST"
  1. I $P(INS(2),U,3)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,3))_HLCS4_$P(INS(3),U,3)_"P"
  1. I $P(INS(2),U,4)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,4))_HLCS4_$P(INS(3),U,4)_"P"
  1. I $P(INS(2),U,5)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,5))_HLCS4_$P(INS(3),U,5)_"I"
  1. I $P(INS(2),U,6)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,6))_HLCS4_$P(INS(3),U,6)_"I"
  1. I $P(INS(2),U,7)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(2),U,7)_HLCS4_"VA"
  1. I $P(INS(0),U,5)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(0),U,5)_HLCS4_"NIF"
  1. I $P(INS(0),U,6)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(0),U,6)_HLCS4_"HPID"
  1. S HLA("HLS",CNT,LN)=HLA("HLS",CNT,LN)_HLFS
  1. S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(0),U,2))_HLFS
  1. S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,1))_HLCS_$$CLEAN($P(INS(1),U,2))_HLCS
  1. S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,3))_HLCS_$P($G(^DIC(5,+$P(INS(1),U,4),0)),U,1)_HLCS
  1. S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,5))_HLCS_HLCS_HLFS_HLFS
  1. S PHN=$$CLEAN($P(INS(1),U,8))
  1. S:PHN]"" PHN=HLCS11_PHN
  1. S LN=LN+1,HLA("HLS",CNT,LN)=PHN_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS
  1. S TOC=$P(INS(1),U,7)
  1. S:TOC="" TOC=1
  1. S LN=LN+1,HLA("HLS",CNT,LN)=$P($G(^IBE(355.2,TOC,0)),U,1)
  1. ;
  1. ;CALL HL7 TO TRANSMIT SINGLE MESSAGE
  1. D GENERATE^HLMA("IB NIF QUERY DRIVER","LM",1,.HLRSLT)
  1. S %=$$FM71^IBCNHUT2(INSCO,$P(HLRSLT,U,1)) ;update transmission queue in #367.1
  1. Q
  1. ;
  1. ;IB*2.0*521/ZEB: added CLEAN tag to remove delimiters from fields for HL7
  1. ;CLEAN removes HL7 separators of pipe | and tilde ~ from a string
  1. CLEAN(STR) ;STR: the string to clean up
  1. Q $TR(STR,"|~","")