IBCNHHLO ;ALB/ZEB - HL7 Sender for NIF transmissions ;25-FEB-14
;;2.0;INTEGRATED BILLING;**519,521**;21-MAR-94;Build 33
;;Per VA Directive 6402, this routine should not be modified.
;**Program Description**
; This program will process outgoing NIF query messages.
; Call at tags only
Q
;IB*2.0*521/ZEB: Used new $$CLEAN function to remove HL7 delimiters from free-text fields
SEND(INSCO) ;INSCO: IEN of Insurance Company record to send
Q:+$P($G(^IBE(350.9,1,70)),U,1)'=1 ;abort if secret HL7 flag isn't set
K HLA,HLEVN
N CNT,HL,HLFS,HLCS,HLRS,LN,INS,HLRSLT,HLCS11,HLCSCNT,TOC,PHN,HLCS4
S CNT=0
;set up environment for message
D INIT^HLFNC2("IB NIF QUERY DRIVER",.HL)
S HLFS=$G(HL("FS")) I HLFS="" S HLFS="|"
S HLCS=$E(HL("ECH"),1)
S HLCS4=HLCS
F HLCSCNT=1:1:3 S HLCS4=HLCS4_HLCS
S HLCS11=HLCS4
F HLCSCNT=1:1:7 S HLCS11=HLCS11_HLCS
S HLRS=$E(HL("ECH"),2)
D R36^IBCNHUT2(INSCO,.INS) ;get info from ins. co. record
;Add message txt to HLA array
; add QPD segment
S CNT=CNT+1,HLA("HLS",CNT)="QPD"_HLFS_"ZHPID01"_HLCS_"HPID Insurance Inquiry"
; add an empty RCP segment
S CNT=CNT+1,HLA("HLS",CNT)="RCP"_HLFS_"I"
; add IN1 segment
S LN=0
S CNT=CNT+1,HLA("HLS",CNT)="IN1"_HLFS
S LN=LN+1,HLA("HLS",CNT,LN)="0001"_HLFS_"VA"_HLCS_"Department of Veterans Affairs"_HLFS
S LN=LN+1,HLA("HLS",CNT,LN)=$P($$SITE^VASITE,U,3)_"."_INSCO_HLCS4_"INS"
I $P(INS(2),U,1)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,1))_HLCS4_"PROF"
I $P(INS(2),U,2)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,2))_HLCS4_"INST"
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"
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"
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"
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"
I $P(INS(2),U,7)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(2),U,7)_HLCS4_"VA"
I $P(INS(0),U,5)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(0),U,5)_HLCS4_"NIF"
I $P(INS(0),U,6)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(0),U,6)_HLCS4_"HPID"
S HLA("HLS",CNT,LN)=HLA("HLS",CNT,LN)_HLFS
S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(0),U,2))_HLFS
S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,1))_HLCS_$$CLEAN($P(INS(1),U,2))_HLCS
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
S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,5))_HLCS_HLCS_HLFS_HLFS
S PHN=$$CLEAN($P(INS(1),U,8))
S:PHN]"" PHN=HLCS11_PHN
S LN=LN+1,HLA("HLS",CNT,LN)=PHN_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS
S TOC=$P(INS(1),U,7)
S:TOC="" TOC=1
S LN=LN+1,HLA("HLS",CNT,LN)=$P($G(^IBE(355.2,TOC,0)),U,1)
;
;CALL HL7 TO TRANSMIT SINGLE MESSAGE
D GENERATE^HLMA("IB NIF QUERY DRIVER","LM",1,.HLRSLT)
S %=$$FM71^IBCNHUT2(INSCO,$P(HLRSLT,U,1)) ;update transmission queue in #367.1
Q
;
;IB*2.0*521/ZEB: added CLEAN tag to remove delimiters from fields for HL7
;CLEAN removes HL7 separators of pipe | and tilde ~ from a string
CLEAN(STR) ;STR: the string to clean up
Q $TR(STR,"|~","")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNHHLO 3239 printed Nov 22, 2024@17:25:49 Page 2
IBCNHHLO ;ALB/ZEB - HL7 Sender for NIF transmissions ;25-FEB-14
+1 ;;2.0;INTEGRATED BILLING;**519,521**;21-MAR-94;Build 33
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;**Program Description**
+4 ; This program will process outgoing NIF query messages.
+5 ; Call at tags only
+6 QUIT
+7 ;IB*2.0*521/ZEB: Used new $$CLEAN function to remove HL7 delimiters from free-text fields
SEND(INSCO) ;INSCO: IEN of Insurance Company record to send
+1 ;abort if secret HL7 flag isn't set
if +$PIECE($GET(^IBE(350.9,1,70)),U,1)'=1
QUIT
+2 KILL HLA,HLEVN
+3 NEW CNT,HL,HLFS,HLCS,HLRS,LN,INS,HLRSLT,HLCS11,HLCSCNT,TOC,PHN,HLCS4
+4 SET CNT=0
+5 ;set up environment for message
+6 DO INIT^HLFNC2("IB NIF QUERY DRIVER",.HL)
+7 SET HLFS=$GET(HL("FS"))
IF HLFS=""
SET HLFS="|"
+8 SET HLCS=$EXTRACT(HL("ECH"),1)
+9 SET HLCS4=HLCS
+10 FOR HLCSCNT=1:1:3
SET HLCS4=HLCS4_HLCS
+11 SET HLCS11=HLCS4
+12 FOR HLCSCNT=1:1:7
SET HLCS11=HLCS11_HLCS
+13 SET HLRS=$EXTRACT(HL("ECH"),2)
+14 ;get info from ins. co. record
DO R36^IBCNHUT2(INSCO,.INS)
+15 ;Add message txt to HLA array
+16 ; add QPD segment
+17 SET CNT=CNT+1
SET HLA("HLS",CNT)="QPD"_HLFS_"ZHPID01"_HLCS_"HPID Insurance Inquiry"
+18 ; add an empty RCP segment
+19 SET CNT=CNT+1
SET HLA("HLS",CNT)="RCP"_HLFS_"I"
+20 ; add IN1 segment
+21 SET LN=0
+22 SET CNT=CNT+1
SET HLA("HLS",CNT)="IN1"_HLFS
+23 SET LN=LN+1
SET HLA("HLS",CNT,LN)="0001"_HLFS_"VA"_HLCS_"Department of Veterans Affairs"_HLFS
+24 SET LN=LN+1
SET HLA("HLS",CNT,LN)=$PIECE($$SITE^VASITE,U,3)_"."_INSCO_HLCS4_"INS"
+25 IF $PIECE(INS(2),U,1)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$$CLEAN($PIECE(INS(2),U,1))_HLCS4_"PROF"
+26 IF $PIECE(INS(2),U,2)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$$CLEAN($PIECE(INS(2),U,2))_HLCS4_"INST"
+27 IF $PIECE(INS(2),U,3)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$$CLEAN($PIECE(INS(2),U,3))_HLCS4_$PIECE(INS(3),U,3)_"P"
+28 IF $PIECE(INS(2),U,4)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$$CLEAN($PIECE(INS(2),U,4))_HLCS4_$PIECE(INS(3),U,4)_"P"
+29 IF $PIECE(INS(2),U,5)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$$CLEAN($PIECE(INS(2),U,5))_HLCS4_$PIECE(INS(3),U,5)_"I"
+30 IF $PIECE(INS(2),U,6)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$$CLEAN($PIECE(INS(2),U,6))_HLCS4_$PIECE(INS(3),U,6)_"I"
+31 IF $PIECE(INS(2),U,7)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$PIECE(INS(2),U,7)_HLCS4_"VA"
+32 IF $PIECE(INS(0),U,5)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$PIECE(INS(0),U,5)_HLCS4_"NIF"
+33 IF $PIECE(INS(0),U,6)]""
SET LN=LN+1
SET HLA("HLS",CNT,LN)=HLRS_$PIECE(INS(0),U,6)_HLCS4_"HPID"
+34 SET HLA("HLS",CNT,LN)=HLA("HLS",CNT,LN)_HLFS
+35 SET LN=LN+1
SET HLA("HLS",CNT,LN)=$$CLEAN($PIECE(INS(0),U,2))_HLFS
+36 SET LN=LN+1
SET HLA("HLS",CNT,LN)=$$CLEAN($PIECE(INS(1),U,1))_HLCS_$$CLEAN($PIECE(INS(1),U,2))_HLCS
+37 SET LN=LN+1
SET HLA("HLS",CNT,LN)=$$CLEAN($PIECE(INS(1),U,3))_HLCS_$PIECE($GET(^DIC(5,+$PIECE(INS(1),U,4),0)),U,1)_HLCS
+38 SET LN=LN+1
SET HLA("HLS",CNT,LN)=$$CLEAN($PIECE(INS(1),U,5))_HLCS_HLCS_HLFS_HLFS
+39 SET PHN=$$CLEAN($PIECE(INS(1),U,8))
+40 if PHN]""
SET PHN=HLCS11_PHN
+41 SET LN=LN+1
SET HLA("HLS",CNT,LN)=PHN_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS
+42 SET TOC=$PIECE(INS(1),U,7)
+43 if TOC=""
SET TOC=1
+44 SET LN=LN+1
SET HLA("HLS",CNT,LN)=$PIECE($GET(^IBE(355.2,TOC,0)),U,1)
+45 ;
+46 ;CALL HL7 TO TRANSMIT SINGLE MESSAGE
+47 DO GENERATE^HLMA("IB NIF QUERY DRIVER","LM",1,.HLRSLT)
+48 ;update transmission queue in #367.1
SET %=$$FM71^IBCNHUT2(INSCO,$PIECE(HLRSLT,U,1))
+49 QUIT
+50 ;
+51 ;IB*2.0*521/ZEB: added CLEAN tag to remove delimiters from fields for HL7
+52 ;CLEAN removes HL7 separators of pipe | and tilde ~ from a string
CLEAN(STR) ;STR: the string to clean up
+1 QUIT $TRANSLATE(STR,"|~","")
