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

IBCNIUHL.m

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