- 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 Feb 18, 2025@23:42:08 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,"|~","")