IBCNIUHL ;AITC/TAZ - IIU PROCESS SEND INSURANCE TRANSMISSIONS ; 04/06/21 12:46p.m.
;;2.0;INTEGRATED BILLING;**687,713**;21-MAR-94;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
;**Program Description**
; This routine is the driver routine for sending an Interfacility Insurance Update message.
; It consists of both real time (RT) and delayed (NIGHT) transmissions.
;
NIGHT ;Main Entry Point for Nightly Process
;
N DISYS,IIUIEN,XREF
;
; 1. If IIU Master Switch is "NO" or Null goto NIGHTQ
;
I $$GET1^DIQ(350.9,1_",",53.01,"I")'="Y" G NIGHTQ
;
; 2. Process Entries in INTERFACILITY INSURANCE UPDATE File (#365.19)
; a. Use the "C" Cross References for status of Partial and Waiting
; b. If Payer is deactivated quit
; c. Call RT(IIUIEN)
;
F XREF="P","W" D
. S IIUIEN=0
. F S IIUIEN=$O(^IBCN(365.19,"C",XREF,IIUIEN)) Q:'IIUIEN D
.. N PIEN
.. S PIEN=$$GET1^DIQ(365.19,IIUIEN_",",1.02,"I")
.. I $$PYRDEACT^IBCNINSU(PIEN) Q
.. D RT(IIUIEN)
;
NIGHTQ ; Exit Night Processing
;
Q
;
RT(IIUIEN) ; Real Time IIU Processing
;INPUT:
; IIUIEN - Internal Entry Number of the IIU data
;
N ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
;
;If not AUTOUPDATE, Queue the entry for 5 minutes to insure all buffer updates are complete.
I $$GET1^DIQ(365.19,IIUIEN_",",1.04,"I")'=1 D G RTQ
. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,5)
. S ZTDESC="IIU BUFFER SUBMISSION ("_IIUIEN_")"
. S ZTIO=""
. S ZTQUEUED=1
. S ZTRTN="BUFFER^IBCNIUHL("_IIUIEN_")"
. D ^%ZTLOAD
;
RT1 ; entry tag for BUFFER^IBCNIUHL that we had to job off, this will correctly
; update the values in the DATA array
;
;IB*713/CKB add BADMSG variable to stop HL7 processing due to foreign characters
N DA,DATA,DISYS,DFN,EFFDT,EFLAG,EXPDT,FAC,BADMSG,HCT,IBADDR,IBCNHLP,IBSDATA,ICN,IENS,INSIEN,INSIENS
N NM,PDATE,PIEN,PIENS,PREL,PTR,ROUTINE,VACNTRY,ZMID
N HL,HL771RF,HL771SF,HLA,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLDOMP,HLECH,HLFS,HLHDR,HLINST,HLINSTN,HLIP,HLL,HLN
N HLPARAM,HLPID,HLPROD,HLREC,HLRESLT,HLRFREQ,HLSFREQ,HLTYPE,HLX
;
D GETS^DIQ(365.19,IIUIEN_",","**","EI","DATA","ERROR")
; Check Payer Data
; 1. Get Payer IEN based on Insurance Company
; a. If IIU Nationally Enabled is "NOT ENABLED" or Null Quit
; b. If IIU Locally Enabled is "NOT ENABLED" or Null Quit
S PIEN=$G(DATA(365.19,IIUIEN_",",1.02,"I")) I 'PIEN G RTQ
D PAYER^IBCNINSU(PIEN,"IIU",,"IE",.DATA)
S PIENS=$O(DATA(365.121,""))
I '$G(DATA(365.121,PIENS,.02,"I")) G RTQ ;If IIU Nationally Enabled is "NOT ENABLED" or Null Quit
I '$G(DATA(365.121,PIENS,.03,"I")) G RTQ ;If IIU Locally Enabled is "NOT ENABLED" or Null Quit
;
;Set Up IIU variables to be sent
S DFN=$G(DATA(365.19,IIUIEN_",",.01,"I"))
S INSIEN=$G(DATA(365.19,IIUIEN_",",1.03,"I")),INSIENS=INSIEN_","_DFN_","
D GETS^DIQ(2.312,INSIENS,"*","IE","DATA")
;
S IBCNHLP="IBCNIU PIN/I07 EVENT" ;Event driver
;
; Initialize HL7
D INIT
;
;Get facilities into HLL Array
;HLL("LINKS",n)=SUBSCRIBER PROTOCOL^LOGICAL LINK TO SEND TO
K HLL("LINKS")
N CNT S CNT=0
S FAC="" F S FAC=$O(DATA(365.191,FAC)) Q:'FAC D
. N LINK,LINKIEN
. I $G(DATA(365.191,FAC,.02,"I"))'="R" K DATA(365.191,FAC) Q ;Remove if not Ready to Send
. D LINK^HLUTIL3($G(DATA(365.191,FAC,.01,"I")),.LINK)
. S LINKIEN=$O(LINK("")) I 'LINKIEN K DATA(365.191,FAC) Q ;Remove if can't resolve link
. S CNT=CNT+1,HLL("LINKS",CNT)="IBCNIU PIN/I07 SUB"_U_LINK(LINKIEN)
I 'CNT G RTQ ; No facilities to send
;
S BADMSG=0 ;IB*713 - initialize to 0 - "NO"
;
; Build PIN-I07 record
D BLD(.DATA)
;
I $G(EFLAG) G RTQ ;Error creating HL7 record. Try later.
;NOTE: BADMSG Returns 1-"YES" if processing is to stop.
I BADMSG G RTQ ;IB*713/CKB DO NOT send HL7 msg
;
; Generate HL7 record
D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"","")
;
;Update SENT STATUS (#.02)
I '+$P(HLRESLT,U,2) D
. S FAC=""
. F S FAC=$O(DATA(365.191,FAC)) Q:'FAC D
.. S IBDFDA=+FAC
.. S IBDFDA(1)=IIUIEN
.. S DATA(.02)="S"
.. I $$UPD^IBDFDBS(365.191,.IBDFDA,.DATA)
;
; Set SENDER STATUS (#1.01)
K IBDFDA,DATA
S IBDFDA=IIUIEN
I '$D(^IBCN(365.19,IBDFDA,1.1,"C","R")) S DATA(1.01)="C"
I '$D(DATA(1.01)),'$D(^IBCN(365.19,IBDFDA,1.1,"C","S")) S DATA(1.01)="W"
I '$D(DATA(1.01)) S DATA(1.01)="P"
I $$UPD^IBDFDBS(365.19,.IBDFDA,.DATA)
;
K ^TMP("HLS",$J),HLP
;
RTQ ;Exit Real-Time IIU transmission
Q
;
INIT ; Initialization for HL7
D INIT^HLFNC2(IBCNHLP,.HL)
S HLFS=HL("FS"),HLECH=$E(HL("ECH"),1)
S HCT=0
Q
;
BLD(DATA) ; Build the PIN_I07 record.
; Input:
; DATA - Data Array of all variables for the record from IIU (#365.19), PAYER (#365.12),
; and INSURANCE TYPE (#2.312) files
;
N BIN,DOB,FLD,GRP,GT1,IN1,INSDOB,NTE,PCN,PID,PRD,SUBID,VAFSTR,WHO
; The following variables are used in multiple segments
S DOB=$G(DATA(2.312,INSIENS,3.01,"I")) ;DATE OF BIRTH
S SUBID=$G(DATA(365.19,IIUIEN_",",1.06,"E")) ;SUBSCRIBER ID
S PREL=$G(DATA(2.312,INSIENS,4.03,"I")) ;PATIENT RELATIONSHIP - HIPAA
S GRP=$G(DATA(2.312,INSIENS,.18,"I")) ;Pointer to Group in #355.3
S WHO=$G(DATA(2.312,INSIENS,6,"I")) ;WHOSE INSURANCE
;
;Set up PRD node
S HCT=HCT+1,^TMP("HLS",$J,HCT)="PRD"_HLFS_"NA"
;
;Set up PID Node
S VAFSTR=",1,"
S PID=$$EN^VAFHLPID(DFN,VAFSTR,1)
S ICN=$$GETICN^MPIF001(DFN)
I 'ICN S EFLAG=1 G BLDQ ; ICN is required
I $E(ICN,1,3)=$P($$SITE^VASITE,U,3) S EFLAG=1 G BLDQ ;local ICN, skip patient
S $P(PID,HLFS,4)=ICN_HLECH_HLECH_HLECH_"USVHA"_HLECH_"NI"_HLECH_"USVHA"
;
I PID=""!(PID?."*") S EFLAG=1 G BLDQ
;
S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(PID,"*","")
;
;Set up GT1 Node if dependent policy
S GT1=""
;
I WHO'="v",(WHO'="") D
. ; segment 2 - Subscriber ID
. S $P(GT1,HLFS,2)=$$SCRUB($G(SUBID))_HLECH_HLECH_HLECH_HLECH_"HC"
. ; segment 3 - Guarantor Name (Name of Insured)
. S NM=$G(DATA(2.312,INSIENS,7.01,"I")) ; Set name to NAME OF INSURED
. S NM=$$HLNAME^HLFNC(NM,HLECH)
;
;IB*713/CKB - add checks for foreign characters
;If foreign chars encountered DO NOT send HL7
I GT1]"",$$FOREIGN^IBCNINSU($P(GT1,HLFS,2)) S BADMSG=1 Q ;GT1-2 SUBSCRIBER ID
;
;If foreign chars encountered clear field and continue with msg
; GT1-3 SUBSCRIBER NAME/NAME OF INSURED
I GT1]"" S FLD=$P(GT1,HLFS,3) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(GT1,HLFS,3)=FLD ;GT1-3
;
I GT1]"" D
. S $P(GT1,HLFS,1)=1,GT1="GT1"_HLFS_GT1 ;
. I GT1'?."*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(GT1,"*","")
;
;Set up IN1 Node
S IN1=""
;
; Segment 2 - Insurance Plan ID
S $P(IN1,HLFS,2)=$S(PREL=18:$$SCRUB($G(SUBID)),PREL="":$$SCRUB($G(SUBID)),1:$$SCRUB($G(DATA(2.312,INSIENS,5.01,"I"))))
; Segment 3 - Insurance Company ID (Payer)
S $P(IN1,HLFS,3)=$$ENCHL7($G(DATA(365.12,PIEN_",",.02,"E")))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"
; Segment 4 - Insurance Company Name
S $P(IN1,HLFS,4)=$$ENCHL7($G(DATA(2.312,INSIENS,.01,"E")))
; Segment 8 - Group Number
S $P(IN1,HLFS,8)=$$ENCHL7($G(DATA(2.312,INSIENS,21,"E")))
; Segment 9 - Group Name
S $P(IN1,HLFS,9)=$$ENCHL7($G(DATA(2.312,INSIENS,20,"E")))
;
;IB*713/CKB - add check for foreign characters
;If foreign chars encountered DO NOT send HL7
I $$FOREIGN^IBCNINSU($P(IN1,HLFS,2)) S BADMSG=1 Q ;IN1-2 PATIENT/SUBSCRIBER ID
;
;If foreign chars encountered clear field and continue with msg
S FLD=$P(IN1,HLFS,8) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,8)=FLD ;IN1-8 GROUP NUMBER
S FLD=$P(IN1,HLFS,9) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,9)=FLD ;IN1-9 GROUP NAME
;
; Segment 12 - Effective Date of Policy
S EFFDT=$G(DATA(2.312,INSIENS,8,"I")),$P(IN1,HLFS,12)=$$HLDATE^HLFNC(EFFDT)
; Segment 15 - Plan Type
S $P(IN1,HLFS,15)=$$GET1^DIQ(355.3,GRP_",",.09,"I")
; Segment 17 - Patient Relationship - HIPAA
S $P(IN1,HLFS,17)=$G(DATA(2.312,INSIENS,4.03,"I"))
; Segment 18 - Insured's DOB
S INSDOB=$G(DATA(2.312,INSIENS,3.01,"I"))
I WHO="v",INSDOB="" S INSDOB=$$GET1^DIQ(2,DFN_",",.03,"I")
S $P(IN1,HLFS,18)=$$HLDATE^HLFNC(INSDOB)
; Segment 22 - Coordination of Benefits
S $P(IN1,HLFS,22)=$G(DATA(365.19,IIUIEN_",",1.07,"I"))
;
I IN1]"" D
. S $P(IN1,HLFS,1)=1,IN1="IN1"_HLFS_IN1
. I IN1'?."*" S HCT=HCT+1 S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","")
;
;Set up NTE Node
S NTE=""
;
; Segment 3 - Whose Insurance~BIN~PCN
S BIN=$$ENCHL7($$GET1^DIQ(355.3,GRP_",",6.02,"E")) ;Banking Identification Number (BIN)
S PCN=$$ENCHL7($$GET1^DIQ(355.3,GRP_",",6.03,"E")) ;Processor Control Number (PCN)
S $P(NTE,HLFS,3)=WHO_HLECH_BIN_HLECH_PCN
;
I NTE]"" D
. S $P(NTE,HLFS,1)=1,NTE="NTE"_HLFS_NTE
. I NTE'?."*" S HCT=HCT+1 S ^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
;
BLDQ ;
Q
;
ENCHL7(STR) ; Encode HL7 escape seqs in data fields
;INPUT:
; STR - String to be encoded
; HL - Array containing HL components returned from INIT^HLFNC2
;
; Returns an encoded string
; The encoded characters are:
; /F/ - Field Separator
; /C/ - Component Separator
; /R/ - Repetition Separator
; /E/ - Escape Character
; /S/ - Sub-component Separator
;
N CHR,ENCCHR,IDX
I STR']"" G ENCHL7Q ;Nothing to encode
I '$D(HL) G ENCHL7Q ;No encoding characters defined
S ENCCHR="CRES"
;
; Check for field Separator
F Q:STR'[HL("FS") S STR=$P(STR,HL("FS"),1)_"/F/"_$P(STR,HL("FS"),2,99)
F IDX=1:1:$L(HL("ECH")) S CHR=$E(HL("ECH"),IDX) F Q:STR'[CHR S STR=$P(STR,CHR,1)_"/"_$E(ENCCHR,IDX)_"/"_$P(STR,CHR,2,99)
;
ENCHL7Q ;
Q STR
;
SCRUB(Z) ; remove all punctuation from the string and convert lowercase to uppercase
S Z=$$NOPUNCT^IBCEF(Z,1)
S Z=$$UP^XLFSTR(Z)
SCRUBX ;
Q Z
;
BUFFER(IIUIEN) ;
;Job was queued with a 5 minute delay because ICB has to take back control
; then save the patient data to the patient's record in subfile #2.312.
N DATA,DFN,FIELD,INSIEN,INSIENS,OK,STAT
S OK=1
S DFN=$$GET1^DIQ(365.19,IIUIEN_",",.01,"I")
S INSIEN=$$GET1^DIQ(365.19,IIUIEN_",",1.03,"I"),INSIENS=INSIEN_","_DFN_","
;
;Picking up the fields after the 5 minute delay to ensure we are getting the correct values
S DATA(1.06)=$$GET1^DIQ(2.312,INSIENS,7.02,"I") ;Subscriber ID to be sent to remote facility
S DATA(1.07)=$$GET1^DIQ(2.312,INSIENS,.2,"I") ;Coordination of Benefits to be sent to remote facility
I $$UPD^IBDFDBS(365.19,IIUIEN,.DATA)
K DATA
;
D GETS^DIQ(2.312,INSIENS,".01;3.01;4.03;5.01;7.01;7.02","IE","DATA")
;
;Check for IIU Required fields in the Patient record, file #2 and subfile #2.312
; Patient name + Patient DOB + Insurance Company Name + Name of Insured + Subscriber ID
;Checking Patient Name, Patient Date of Birth
F FIELD=.01,.03 D I 'OK G BUFFERQ
. I $$GET1^DIQ(2,DFN_",",FIELD,"E")="" S OK=0
;
;Checking Insurance Company Name, Name of Insured, Subscriber ID
F FIELD=.01,7.01,7.02 D I 'OK G BUFFERQ
. I $G(DATA(2.312,INSIENS,FIELD,"E"))="" S OK=0
;
;IF Pt. Relationship-HIPAA is not SELF, then Insured Date of Birth + Patient ID are required
I DATA(2.312,INSIENS,4.03,"E")'="SELF" D
. I $G(DATA(2.312,INSIENS,3.01,"E"))="" S OK=0 Q ;Insured Date of Birth
. I $G(DATA(2.312,INSIENS,5.01,"E"))="" S OK=0 ;Patient ID
;
BUFFERQ ;Exit
;
;Everything checks out. Process entry real time.
I OK G RT1
;
;If any of the required fields are missing data, set the SENDER STATUS (#1.01)
; in the INTERFACILITY UPDATE file #365.19 to 'F'-FAILED MISSING DATA
S STAT(1.01)="F"
I $$UPD^IBDFDBS(365.19,IIUIEN,.STAT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNIUHL 11614 printed Oct 16, 2024@18:16:39 Page 2
IBCNIUHL ;AITC/TAZ - IIU PROCESS SEND INSURANCE TRANSMISSIONS ; 04/06/21 12:46p.m.
+1 ;;2.0;INTEGRATED BILLING;**687,713**;21-MAR-94;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;**Program Description**
+7 ; This routine is the driver routine for sending an Interfacility Insurance Update message.
+8 ; It consists of both real time (RT) and delayed (NIGHT) transmissions.
+9 ;
NIGHT ;Main Entry Point for Nightly Process
+1 ;
+2 NEW DISYS,IIUIEN,XREF
+3 ;
+4 ; 1. If IIU Master Switch is "NO" or Null goto NIGHTQ
+5 ;
+6 IF $$GET1^DIQ(350.9,1_",",53.01,"I")'="Y"
GOTO NIGHTQ
+7 ;
+8 ; 2. Process Entries in INTERFACILITY INSURANCE UPDATE File (#365.19)
+9 ; a. Use the "C" Cross References for status of Partial and Waiting
+10 ; b. If Payer is deactivated quit
+11 ; c. Call RT(IIUIEN)
+12 ;
+13 FOR XREF="P","W"
Begin DoDot:1
+14 SET IIUIEN=0
+15 FOR
SET IIUIEN=$ORDER(^IBCN(365.19,"C",XREF,IIUIEN))
if 'IIUIEN
QUIT
Begin DoDot:2
+16 NEW PIEN
+17 SET PIEN=$$GET1^DIQ(365.19,IIUIEN_",",1.02,"I")
+18 IF $$PYRDEACT^IBCNINSU(PIEN)
QUIT
+19 DO RT(IIUIEN)
End DoDot:2
End DoDot:1
+20 ;
NIGHTQ ; Exit Night Processing
+1 ;
+2 QUIT
+3 ;
RT(IIUIEN) ; Real Time IIU Processing
+1 ;INPUT:
+2 ; IIUIEN - Internal Entry Number of the IIU data
+3 ;
+4 NEW ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+5 ;
+6 ;If not AUTOUPDATE, Queue the entry for 5 minutes to insure all buffer updates are complete.
+7 IF $$GET1^DIQ(365.19,IIUIEN_",",1.04,"I")'=1
Begin DoDot:1
+8 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,5)
+9 SET ZTDESC="IIU BUFFER SUBMISSION ("_IIUIEN_")"
+10 SET ZTIO=""
+11 SET ZTQUEUED=1
+12 SET ZTRTN="BUFFER^IBCNIUHL("_IIUIEN_")"
+13 DO ^%ZTLOAD
End DoDot:1
GOTO RTQ
+14 ;
RT1 ; entry tag for BUFFER^IBCNIUHL that we had to job off, this will correctly
+1 ; update the values in the DATA array
+2 ;
+3 ;IB*713/CKB add BADMSG variable to stop HL7 processing due to foreign characters
+4 NEW DA,DATA,DISYS,DFN,EFFDT,EFLAG,EXPDT,FAC,BADMSG,HCT,IBADDR,IBCNHLP,IBSDATA,ICN,IENS,INSIEN,INSIENS
+5 NEW NM,PDATE,PIEN,PIENS,PREL,PTR,ROUTINE,VACNTRY,ZMID
+6 NEW HL,HL771RF,HL771SF,HLA,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLDOMP,HLECH,HLFS,HLHDR,HLINST,HLINSTN,HLIP,HLL,HLN
+7 NEW HLPARAM,HLPID,HLPROD,HLREC,HLRESLT,HLRFREQ,HLSFREQ,HLTYPE,HLX
+8 ;
+9 DO GETS^DIQ(365.19,IIUIEN_",","**","EI","DATA","ERROR")
+10 ; Check Payer Data
+11 ; 1. Get Payer IEN based on Insurance Company
+12 ; a. If IIU Nationally Enabled is "NOT ENABLED" or Null Quit
+13 ; b. If IIU Locally Enabled is "NOT ENABLED" or Null Quit
+14 SET PIEN=$GET(DATA(365.19,IIUIEN_",",1.02,"I"))
IF 'PIEN
GOTO RTQ
+15 DO PAYER^IBCNINSU(PIEN,"IIU",,"IE",.DATA)
+16 SET PIENS=$ORDER(DATA(365.121,""))
+17 ;If IIU Nationally Enabled is "NOT ENABLED" or Null Quit
IF '$GET(DATA(365.121,PIENS,.02,"I"))
GOTO RTQ
+18 ;If IIU Locally Enabled is "NOT ENABLED" or Null Quit
IF '$GET(DATA(365.121,PIENS,.03,"I"))
GOTO RTQ
+19 ;
+20 ;Set Up IIU variables to be sent
+21 SET DFN=$GET(DATA(365.19,IIUIEN_",",.01,"I"))
+22 SET INSIEN=$GET(DATA(365.19,IIUIEN_",",1.03,"I"))
SET INSIENS=INSIEN_","_DFN_","
+23 DO GETS^DIQ(2.312,INSIENS,"*","IE","DATA")
+24 ;
+25 ;Event driver
SET IBCNHLP="IBCNIU PIN/I07 EVENT"
+26 ;
+27 ; Initialize HL7
+28 DO INIT
+29 ;
+30 ;Get facilities into HLL Array
+31 ;HLL("LINKS",n)=SUBSCRIBER PROTOCOL^LOGICAL LINK TO SEND TO
+32 KILL HLL("LINKS")
+33 NEW CNT
SET CNT=0
+34 SET FAC=""
FOR
SET FAC=$ORDER(DATA(365.191,FAC))
if 'FAC
QUIT
Begin DoDot:1
+35 NEW LINK,LINKIEN
+36 ;Remove if not Ready to Send
IF $GET(DATA(365.191,FAC,.02,"I"))'="R"
KILL DATA(365.191,FAC)
QUIT
+37 DO LINK^HLUTIL3($GET(DATA(365.191,FAC,.01,"I")),.LINK)
+38 ;Remove if can't resolve link
SET LINKIEN=$ORDER(LINK(""))
IF 'LINKIEN
KILL DATA(365.191,FAC)
QUIT
+39 SET CNT=CNT+1
SET HLL("LINKS",CNT)="IBCNIU PIN/I07 SUB"_U_LINK(LINKIEN)
End DoDot:1
+40 ; No facilities to send
IF 'CNT
GOTO RTQ
+41 ;
+42 ;IB*713 - initialize to 0 - "NO"
SET BADMSG=0
+43 ;
+44 ; Build PIN-I07 record
+45 DO BLD(.DATA)
+46 ;
+47 ;Error creating HL7 record. Try later.
IF $GET(EFLAG)
GOTO RTQ
+48 ;NOTE: BADMSG Returns 1-"YES" if processing is to stop.
+49 ;IB*713/CKB DO NOT send HL7 msg
IF BADMSG
GOTO RTQ
+50 ;
+51 ; Generate HL7 record
+52 DO GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"","")
+53 ;
+54 ;Update SENT STATUS (#.02)
+55 IF '+$PIECE(HLRESLT,U,2)
Begin DoDot:1
+56 SET FAC=""
+57 FOR
SET FAC=$ORDER(DATA(365.191,FAC))
if 'FAC
QUIT
Begin DoDot:2
+58 SET IBDFDA=+FAC
+59 SET IBDFDA(1)=IIUIEN
+60 SET DATA(.02)="S"
+61 IF $$UPD^IBDFDBS(365.191,.IBDFDA,.DATA)
End DoDot:2
End DoDot:1
+62 ;
+63 ; Set SENDER STATUS (#1.01)
+64 KILL IBDFDA,DATA
+65 SET IBDFDA=IIUIEN
+66 IF '$DATA(^IBCN(365.19,IBDFDA,1.1,"C","R"))
SET DATA(1.01)="C"
+67 IF '$DATA(DATA(1.01))
IF '$DATA(^IBCN(365.19,IBDFDA,1.1,"C","S"))
SET DATA(1.01)="W"
+68 IF '$DATA(DATA(1.01))
SET DATA(1.01)="P"
+69 IF $$UPD^IBDFDBS(365.19,.IBDFDA,.DATA)
+70 ;
+71 KILL ^TMP("HLS",$JOB),HLP
+72 ;
RTQ ;Exit Real-Time IIU transmission
+1 QUIT
+2 ;
INIT ; Initialization for HL7
+1 DO INIT^HLFNC2(IBCNHLP,.HL)
+2 SET HLFS=HL("FS")
SET HLECH=$EXTRACT(HL("ECH"),1)
+3 SET HCT=0
+4 QUIT
+5 ;
BLD(DATA) ; Build the PIN_I07 record.
+1 ; Input:
+2 ; DATA - Data Array of all variables for the record from IIU (#365.19), PAYER (#365.12),
+3 ; and INSURANCE TYPE (#2.312) files
+4 ;
+5 NEW BIN,DOB,FLD,GRP,GT1,IN1,INSDOB,NTE,PCN,PID,PRD,SUBID,VAFSTR,WHO
+6 ; The following variables are used in multiple segments
+7 ;DATE OF BIRTH
SET DOB=$GET(DATA(2.312,INSIENS,3.01,"I"))
+8 ;SUBSCRIBER ID
SET SUBID=$GET(DATA(365.19,IIUIEN_",",1.06,"E"))
+9 ;PATIENT RELATIONSHIP - HIPAA
SET PREL=$GET(DATA(2.312,INSIENS,4.03,"I"))
+10 ;Pointer to Group in #355.3
SET GRP=$GET(DATA(2.312,INSIENS,.18,"I"))
+11 ;WHOSE INSURANCE
SET WHO=$GET(DATA(2.312,INSIENS,6,"I"))
+12 ;
+13 ;Set up PRD node
+14 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)="PRD"_HLFS_"NA"
+15 ;
+16 ;Set up PID Node
+17 SET VAFSTR=",1,"
+18 SET PID=$$EN^VAFHLPID(DFN,VAFSTR,1)
+19 SET ICN=$$GETICN^MPIF001(DFN)
+20 ; ICN is required
IF 'ICN
SET EFLAG=1
GOTO BLDQ
+21 ;local ICN, skip patient
IF $EXTRACT(ICN,1,3)=$PIECE($$SITE^VASITE,U,3)
SET EFLAG=1
GOTO BLDQ
+22 SET $PIECE(PID,HLFS,4)=ICN_HLECH_HLECH_HLECH_"USVHA"_HLECH_"NI"_HLECH_"USVHA"
+23 ;
+24 IF PID=""!(PID?."*")
SET EFLAG=1
GOTO BLDQ
+25 ;
+26 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(PID,"*","")
+27 ;
+28 ;Set up GT1 Node if dependent policy
+29 SET GT1=""
+30 ;
+31 IF WHO'="v"
IF (WHO'="")
Begin DoDot:1
+32 ; segment 2 - Subscriber ID
+33 SET $PIECE(GT1,HLFS,2)=$$SCRUB($GET(SUBID))_HLECH_HLECH_HLECH_HLECH_"HC"
+34 ; segment 3 - Guarantor Name (Name of Insured)
+35 ; Set name to NAME OF INSURED
SET NM=$GET(DATA(2.312,INSIENS,7.01,"I"))
+36 SET NM=$$HLNAME^HLFNC(NM,HLECH)
End DoDot:1
+37 ;
+38 ;IB*713/CKB - add checks for foreign characters
+39 ;If foreign chars encountered DO NOT send HL7
+40 ;GT1-2 SUBSCRIBER ID
IF GT1]""
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,2))
SET BADMSG=1
QUIT
+41 ;
+42 ;If foreign chars encountered clear field and continue with msg
+43 ; GT1-3 SUBSCRIBER NAME/NAME OF INSURED
+44 ;GT1-3
IF GT1]""
SET FLD=$PIECE(GT1,HLFS,3)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(GT1,HLFS,3)=FLD
+45 ;
+46 IF GT1]""
Begin DoDot:1
+47 ;
SET $PIECE(GT1,HLFS,1)=1
SET GT1="GT1"_HLFS_GT1
+48 IF GT1'?."*"
SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(GT1,"*","")
End DoDot:1
+49 ;
+50 ;Set up IN1 Node
+51 SET IN1=""
+52 ;
+53 ; Segment 2 - Insurance Plan ID
+54 SET $PIECE(IN1,HLFS,2)=$SELECT(PREL=18:$$SCRUB($GET(SUBID)),PREL="":$$SCRUB($GET(SUBID)),1:$$SCRUB($GET(DATA(2.312,INSIENS,5.01,"I"))))
+55 ; Segment 3 - Insurance Company ID (Payer)
+56 SET $PIECE(IN1,HLFS,3)=$$ENCHL7($GET(DATA(365.12,PIEN_",",.02,"E")))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"
+57 ; Segment 4 - Insurance Company Name
+58 SET $PIECE(IN1,HLFS,4)=$$ENCHL7($GET(DATA(2.312,INSIENS,.01,"E")))
+59 ; Segment 8 - Group Number
+60 SET $PIECE(IN1,HLFS,8)=$$ENCHL7($GET(DATA(2.312,INSIENS,21,"E")))
+61 ; Segment 9 - Group Name
+62 SET $PIECE(IN1,HLFS,9)=$$ENCHL7($GET(DATA(2.312,INSIENS,20,"E")))
+63 ;
+64 ;IB*713/CKB - add check for foreign characters
+65 ;If foreign chars encountered DO NOT send HL7
+66 ;IN1-2 PATIENT/SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(IN1,HLFS,2))
SET BADMSG=1
QUIT
+67 ;
+68 ;If foreign chars encountered clear field and continue with msg
+69 ;IN1-8 GROUP NUMBER
SET FLD=$PIECE(IN1,HLFS,8)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,8)=FLD
+70 ;IN1-9 GROUP NAME
SET FLD=$PIECE(IN1,HLFS,9)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,9)=FLD
+71 ;
+72 ; Segment 12 - Effective Date of Policy
+73 SET EFFDT=$GET(DATA(2.312,INSIENS,8,"I"))
SET $PIECE(IN1,HLFS,12)=$$HLDATE^HLFNC(EFFDT)
+74 ; Segment 15 - Plan Type
+75 SET $PIECE(IN1,HLFS,15)=$$GET1^DIQ(355.3,GRP_",",.09,"I")
+76 ; Segment 17 - Patient Relationship - HIPAA
+77 SET $PIECE(IN1,HLFS,17)=$GET(DATA(2.312,INSIENS,4.03,"I"))
+78 ; Segment 18 - Insured's DOB
+79 SET INSDOB=$GET(DATA(2.312,INSIENS,3.01,"I"))
+80 IF WHO="v"
IF INSDOB=""
SET INSDOB=$$GET1^DIQ(2,DFN_",",.03,"I")
+81 SET $PIECE(IN1,HLFS,18)=$$HLDATE^HLFNC(INSDOB)
+82 ; Segment 22 - Coordination of Benefits
+83 SET $PIECE(IN1,HLFS,22)=$GET(DATA(365.19,IIUIEN_",",1.07,"I"))
+84 ;
+85 IF IN1]""
Begin DoDot:1
+86 SET $PIECE(IN1,HLFS,1)=1
SET IN1="IN1"_HLFS_IN1
+87 IF IN1'?."*"
SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(IN1,"*","")
End DoDot:1
+88 ;
+89 ;Set up NTE Node
+90 SET NTE=""
+91 ;
+92 ; Segment 3 - Whose Insurance~BIN~PCN
+93 ;Banking Identification Number (BIN)
SET BIN=$$ENCHL7($$GET1^DIQ(355.3,GRP_",",6.02,"E"))
+94 ;Processor Control Number (PCN)
SET PCN=$$ENCHL7($$GET1^DIQ(355.3,GRP_",",6.03,"E"))
+95 SET $PIECE(NTE,HLFS,3)=WHO_HLECH_BIN_HLECH_PCN
+96 ;
+97 IF NTE]""
Begin DoDot:1
+98 SET $PIECE(NTE,HLFS,1)=1
SET NTE="NTE"_HLFS_NTE
+99 IF NTE'?."*"
SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=$TRANSLATE(NTE,"*","")
End DoDot:1
+100 ;
BLDQ ;
+1 QUIT
+2 ;
ENCHL7(STR) ; Encode HL7 escape seqs in data fields
+1 ;INPUT:
+2 ; STR - String to be encoded
+3 ; HL - Array containing HL components returned from INIT^HLFNC2
+4 ;
+5 ; Returns an encoded string
+6 ; The encoded characters are:
+7 ; /F/ - Field Separator
+8 ; /C/ - Component Separator
+9 ; /R/ - Repetition Separator
+10 ; /E/ - Escape Character
+11 ; /S/ - Sub-component Separator
+12 ;
+13 NEW CHR,ENCCHR,IDX
+14 ;Nothing to encode
IF STR']""
GOTO ENCHL7Q
+15 ;No encoding characters defined
IF '$DATA(HL)
GOTO ENCHL7Q
+16 SET ENCCHR="CRES"
+17 ;
+18 ; Check for field Separator
+19 FOR
if STR'[HL("FS")
QUIT
SET STR=$PIECE(STR,HL("FS"),1)_"/F/"_$PIECE(STR,HL("FS"),2,99)
+20 FOR IDX=1:1:$LENGTH(HL("ECH"))
SET CHR=$EXTRACT(HL("ECH"),IDX)
FOR
if STR'[CHR
QUIT
SET STR=$PIECE(STR,CHR,1)_"/"_$EXTRACT(ENCCHR,IDX)_"/"_$PIECE(STR,CHR,2,99)
+21 ;
ENCHL7Q ;
+1 QUIT STR
+2 ;
SCRUB(Z) ; remove all punctuation from the string and convert lowercase to uppercase
+1 SET Z=$$NOPUNCT^IBCEF(Z,1)
+2 SET Z=$$UP^XLFSTR(Z)
SCRUBX ;
+1 QUIT Z
+2 ;
BUFFER(IIUIEN) ;
+1 ;Job was queued with a 5 minute delay because ICB has to take back control
+2 ; then save the patient data to the patient's record in subfile #2.312.
+3 NEW DATA,DFN,FIELD,INSIEN,INSIENS,OK,STAT
+4 SET OK=1
+5 SET DFN=$$GET1^DIQ(365.19,IIUIEN_",",.01,"I")
+6 SET INSIEN=$$GET1^DIQ(365.19,IIUIEN_",",1.03,"I")
SET INSIENS=INSIEN_","_DFN_","
+7 ;
+8 ;Picking up the fields after the 5 minute delay to ensure we are getting the correct values
+9 ;Subscriber ID to be sent to remote facility
SET DATA(1.06)=$$GET1^DIQ(2.312,INSIENS,7.02,"I")
+10 ;Coordination of Benefits to be sent to remote facility
SET DATA(1.07)=$$GET1^DIQ(2.312,INSIENS,.2,"I")
+11 IF $$UPD^IBDFDBS(365.19,IIUIEN,.DATA)
+12 KILL DATA
+13 ;
+14 DO GETS^DIQ(2.312,INSIENS,".01;3.01;4.03;5.01;7.01;7.02","IE","DATA")
+15 ;
+16 ;Check for IIU Required fields in the Patient record, file #2 and subfile #2.312
+17 ; Patient name + Patient DOB + Insurance Company Name + Name of Insured + Subscriber ID
+18 ;Checking Patient Name, Patient Date of Birth
+19 FOR FIELD=.01,.03
Begin DoDot:1
+20 IF $$GET1^DIQ(2,DFN_",",FIELD,"E")=""
SET OK=0
End DoDot:1
IF 'OK
GOTO BUFFERQ
+21 ;
+22 ;Checking Insurance Company Name, Name of Insured, Subscriber ID
+23 FOR FIELD=.01,7.01,7.02
Begin DoDot:1
+24 IF $GET(DATA(2.312,INSIENS,FIELD,"E"))=""
SET OK=0
End DoDot:1
IF 'OK
GOTO BUFFERQ
+25 ;
+26 ;IF Pt. Relationship-HIPAA is not SELF, then Insured Date of Birth + Patient ID are required
+27 IF DATA(2.312,INSIENS,4.03,"E")'="SELF"
Begin DoDot:1
+28 ;Insured Date of Birth
IF $GET(DATA(2.312,INSIENS,3.01,"E"))=""
SET OK=0
QUIT
+29 ;Patient ID
IF $GET(DATA(2.312,INSIENS,5.01,"E"))=""
SET OK=0
End DoDot:1
+30 ;
BUFFERQ ;Exit
+1 ;
+2 ;Everything checks out. Process entry real time.
+3 IF OK
GOTO RT1
+4 ;
+5 ;If any of the required fields are missing data, set the SENDER STATUS (#1.01)
+6 ; in the INTERFACILITY UPDATE file #365.19 to 'F'-FAILED MISSING DATA
+7 SET STAT(1.01)="F"
+8 IF $$UPD^IBDFDBS(365.19,IIUIEN,.STAT)
+9 QUIT
+10 ;
