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