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

IBCNHUT1.m

Go to the documentation of this file.
  1. IBCNHUT1 ;ALB/GEF - HPID/OEID UTILITIES ;11-MAR-14
  1. ;;2.0;INTEGRATED BILLING;**519,521,668**;21-MAR-94;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; this routine contains various utilities for the HPID project.
  1. Q
  1. ;
  1. HOD(ID,INS,IBHD) ; function to determine if the data is an HPID, an OEID, or an invalid ID
  1. ; HPID/OEID is a 10 character string with the 1st digit being 7 for HPID & 6 for OEID
  1. ; and the 10th digit being a LUHN Check digit. If the optional INS value is passed, an
  1. ; additional validation check will be done, comparing the ID to what is currently on file
  1. ; for that insurance company ien.
  1. ;
  1. ; returns data string: H for HPID, O for OEID, -1 for Invalid ID
  1. ; to call: W $$HOD^IBCNHUT1(X,INS) or I $$HOD^IBCNHUT1(X,INS) it is not a valid ID
  1. ;
  1. ; ID = data string to validate (required)
  1. ; INS = insurance co. ien (optional)
  1. ; IBHD = Insurance co HPID in file 36 (optional)
  1. ;
  1. Q:ID'?10N "-1^HPID/OEID^*"
  1. ; verify the 10th digit is the Luhn check-digit
  1. Q:$E(ID,10)'=$$CKDGT($E(ID,1,9)) "-1^HPID/OEID^*"
  1. ; verify the ID matches what is in the insurance file
  1. I $G(INS)'="",$G(IBHD)="" S IBHD=$$HPD(INS)
  1. I $G(IBHD)>0,IBHD'=ID Q "-1^HPID/OEID^*"
  1. Q:$E(ID)=7 "H^ HPID^"
  1. Q:$E(ID)=6 "O^ OEID^"
  1. Q "-1^HPID/OEID^*"
  1. ;
  1. HPD(INS,V) ; this function returns the HPID/OEID for an insurance company
  1. ; The user must pass INS = Insurance Company ien in file 36
  1. ; V = 1 means run validation checks (not required). Will append an '*' to the HPID if it does NOT pass validation checks
  1. ;
  1. N IBHPD
  1. Q:$G(INS)="" ""
  1. S IBHPD=$P($G(^DIC(36,INS,8)),U) Q:IBHPD="" ""
  1. Q $S($G(V)=1:IBHPD_$P($$HOD(IBHPD,INS,IBHPD),U,3),1:IBHPD)
  1. Q ""
  1. ;
  1. INS(ID,TYP,IBID) ; this function finds the ien of the insurance company entry in file 36 using the NIF ID or the HPID/OEID
  1. ; TYPE=N for NIF or H for HPID/OEID
  1. ; returns data array: IBID(0)=number of entries with this ID, IBID(n)=IEN^ID^Insurance Company name
  1. ; TO CALL: $$INS^IBCNHUT1(ID,TYP,.ARRAY NAME)
  1. ; 11/7/14 - cross-reference format changed with HPID Build 2, now AHOD & ANIF
  1. N C,IEN
  1. S IBID(0)=0,IBID=""
  1. Q:$G(ID)<1 IBID
  1. I $E(TYP)="N" D
  1. .S IEN=0,C=0 F S IEN=$O(^DIC(36,"ANIF",ID,IEN)) Q:'IEN D
  1. ..S C=C+1,IBID(0)=C,IBID(C)=IEN_U_ID_U_$P($G(^DIC(36,IEN,0)),U)
  1. I $E(TYP)="H" D
  1. .S IEN=0,C=0 F S IEN=$O(^DIC(36,"AHOD",ID,IEN)) Q:'IEN D
  1. ..S C=C+1,IBID(0)=C,IBID(C)=IEN_U_ID_U_$P($G(^DIC(36,IEN,0)),U)
  1. Q IBID
  1. ;
  1. NIF(INS) ; this function finds the NIF ID for an insurance company using the ien
  1. ; INS=Insurance Company ien in file 36
  1. ;
  1. Q:$G(INS)="" ""
  1. Q $P($G(^DIC(36,INS,8)),U,4)
  1. Q ""
  1. ;
  1. SHP(INS) ; this function determines if the entry is a CHP or SHP
  1. ; INS = insurance company ien in file 36. Returns C for CHP (Controlling Health Plan) and S for SHP (Sub-Health Plan)
  1. ;
  1. Q:$G(INS)="" ""
  1. Q $P($G(^DIC(36,INS,8)),U,2)
  1. Q ""
  1. ;
  1. PHP(INS) ; this function returns the parent HPID insurance company if applicable
  1. ;
  1. Q:$G(INS)="" ""
  1. Q $P($G(^DIC(36,INS,8)),U,3)
  1. Q ""
  1. ;
  1. VID(INS) ; this function gets the VA National ID for the insurance company/payer
  1. ;
  1. N IBAPP,IBPYR,IBPY0
  1. ; get the ien of the IIV payer application
  1. ;IB*668/TAZ - Changed Payer Application from IIV to EIV
  1. S IBAPP=$O(^IBE(365.13,"B","EIV","")) Q:IBAPP="" ""
  1. ; find the payer
  1. S IBPYR=$P($G(^DIC(36,INS,3)),U,10) Q:IBPYR="" ""
  1. S IBPY0=$G(^IBE(365.12,IBPYR,1,IBAPP,0)) I $P(IBPY0,U,2)=1,$P(IBPY0,U,3)=1 Q $P($G(^IBE(365.12,IBPYR,0)),U,2)
  1. Q ""
  1. ;
  1. UID(INS) ; this function creates the Vista Unique Site ID to send to the NIF
  1. ; returns station#_"."_insurance company ien
  1. Q:INS="" ""
  1. Q $P($$SITE^VASITE(),U,3)_"."_INS
  1. ;
  1. TRG1(IEN,ST) ; this function sets the trigger for the DATE OF FUTURE PURGE (.1) field in file #367.1
  1. ;(HPID/OEID TRANSMISSION QUEUE). If the PROCESSING STATUS (.05) = R for Response Recieved or EXR
  1. ; for Exception Report Reject and the response included a NIF ID, set the purge date to T+14
  1. ; called from field .05 (PROCESSING STATUS ) of file 367 (HPID/OEID RESPONSE).
  1. ; IEN = entry number in file 367, ST=Transmission status being set
  1. ;
  1. N RSP,ID
  1. ; as of 6/23/14, no longer purging EXR
  1. ;I $E(ST)'="R"&(ST'="EXR") Q ""
  1. Q:$E(ST)'="R" ""
  1. ; if response type is UNSOLICITED, set purge date (don't care about NIF ID for these)
  1. Q:$P($G(^IBCNH(367,IEN,0)),U,3)="U" $$FMADD^XLFDT($$NOW^XLFDT,+14)
  1. ; also don't care about NIF ID if EXR
  1. ; as of 6/23/14, don't set purge data for EXR
  1. ;Q:ST="EXR" $$FMADD^XLFDT($$NOW^XLFDT,+14)
  1. ; check response in file 367 for NIF ID, if response contains NIF ID, set future purge date
  1. ; format of D xref: ^IBCNH(367,"D",8 (for NIF ID),ien in file 367,ID multiple ien)=""
  1. Q:'$D(^IBCNH(367,"D",8,IEN)) ""
  1. S ID=$O(^IBCNH(367,"D",8,IEN,"")) Q:$P($G(^IBCNH(367,IEN,1,ID,0)),U,2)="" ""
  1. Q $$FMADD^XLFDT($$NOW^XLFDT,+14)
  1. ;
  1. UNSOL(HLID,RTY,ID,DATA) ; this code handles unsolicited responses which only have the NIF ID, no insurance ien
  1. ; If there are multiple entries in file 36 with the same NIF ID, this code will update all of them.
  1. ;
  1. N DIC,X,Y,DIE,DA,DR,I,C,INS,PS,ARRAY,DLAYGO
  1. Q:RTY'="U" "-1^ED^Error: Not an unsolicited response!"
  1. ; create new entry in 367 for unsolicited responses
  1. S DIC="^IBCNH(367,",DIC(0)="LS",X=HLID,DLAYGO=367 D ^DIC S IEN=+Y Q:Y=-1 "-1^ED^DATABASE Error: HPID RESPONSE entry NOT added!"
  1. S DIE=DIC,DA=IEN,DR=".01///"_HLID_";.03///"_RTY K DIC D ^DIE
  1. ; Now find every entry in file 36 that has this NIF ID and update it
  1. S X=$$INS($P(ID,U,8),"N",.ARRAY)
  1. ; loop through each entry and update file 36
  1. S C=$G(ARRAY(0)) S:C<1 PS=IEN_"^ED^DATABASE Error: NIF ID does not exist at this site!"
  1. F I=1:1:C S INS=$P($G(ARRAY(I)),U),PS=$$FM36^IBCNHUT2(INS,$P(ID,U,9)_U_$P(DATA,U,9)_U_$P(DATA,U,8)_U_$P(ID,U,8))
  1. ; update field .05 in file 367 (PROCESSING STATUS)
  1. Q $$STAT(IEN,$P(PS,U,2))
  1. ;
  1. STAT(IEN,STAT) ; updates field .05 in file 367 (PROCESSING STATUS)
  1. N DIC,DA,DR
  1. S DIE="^IBCNH(367,",DA=IEN,DR=".05///"_STAT D ^DIE
  1. K DIC,DA,DR
  1. Q IEN
  1. ;
  1. CKDGT(ID) ; Function to calculate and return the check digit of an HPID
  1. ; The check digit is calculated using the Luhn Formula for
  1. ; Modulus 10 "double-add-double" Check Digit. A value of 24 is
  1. ; added to the total to account for the implied USA (80840) prefix.
  1. ;
  1. N IBCTOT,IBCN,IBCDIG,IBI
  1. S IBCTOT=24
  1. F IBI=9:-2:1 S IBCN=2*$E(ID,IBI),IBCTOT=IBCTOT+$E(IBCN)+$E(IBCN,2)+$E(ID,IBI-1)
  1. S IBCDIG=150-IBCTOT
  1. Q $E(IBCDIG,$L(IBCDIG))
  1. ;
  1. EXR(INS) ; Purge EXR records if the EDI numbers get updated.
  1. ; if the insurance company has an EXR response (Exception Report Reject), and the EDI#'s
  1. ; get updated, purge the EXR response.
  1. Q:INS=""
  1. N DA,TQIEN,RSIEN,DIK
  1. S TQIEN="" F S TQIEN=$O(^IBCNH(367.1,"INS",INS,TQIEN)) Q:'TQIEN D
  1. .S RSIEN=$P($G(^IBCNH(367.1,TQIEN,0)),U,7) Q:RSIEN=""
  1. .Q:$P($G(^IBCNH(367,RSIEN,0)),U,5)'="EXR"
  1. .S DA=TQIEN,DIK="^IBCNH(367.1," D ^DIK
  1. .S DA=RSIEN,DIK="^IBCNH(367," D ^DIK
  1. K DA,TQIEN,RSIEN,DIK
  1. Q