IBNCPUT1 ;BHAM ISC/SS - IB NCPDP UTILITIES ;22-MAR-2006
;;2.0;INTEGRATED BILLING;**342,363,384,550**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
;Utilities for NPCDP
;/**
;Creates a new entry in the file or subfile with .01 field
;IBFILE - file/subfile #
;IBIEN - ien of the parent file entry in which the new subfile entry will be inserted
;IBVAL01 - .01 value for the new entry
;NEWRECNO -(optional) specify IEN if you want specific value
; Note: if "" then the system will assign the entry number itself.
;IBFLGS - FLAGS parameter for UPDATE^DIE
;
;Examples
;top level:
; INSITEM(366.14,"",IBDATE,"")
; INSITEM(366.14,"",IBDATE,45)
;
;1st level multiple:
; subfile number = #366.141
; parent file #366.14 entry number = 345
; INSITEM(366.141,345,"SUBMIT","")
; to create mupltiple entry with particular entry number = 23
; INSITEM(366.141,345,"SUBMIT",23)
;
;2nd level multiple
;parent file #366.14 entry number = 234
;parent multiple entry number = 55
;create mupltiple entry INSURANCE
; INSITEM(366.1412,"55,234","INS","")
; results in :
; ^IBCNR(366.14,234,1,55,5,0)=^366.1412PA^1^1
; ^IBCNR(366.14,234,1,55,5,1,0)=INS
; ^IBCNR(366.14,234,1,55,5,"B","INS",1)=
; (DD node for this muptiple =5 )
;
;output :
; positive number - record # created
; <=0 - failure
; See description above
INSITEM(IBFILE,IBIEN,IBVAL01,NEWRECNO,IBFLGS) ;*/
N IBSSI,IBIENS,IBFDA,IBERR
I '$G(NEWRECNO) N NEWRECNO S NEWRECNO=$G(NEWRECNO)
I IBIEN'="" S IBIENS="+1,"_IBIEN_"," I $L(NEWRECNO)>0 S IBSSI(1)=+NEWRECNO
I IBIEN="" S IBIENS="+1," I $L(NEWRECNO)>0 S IBSSI(1)=+NEWRECNO
S IBFDA(IBFILE,IBIENS,.01)=IBVAL01
D UPDATE^DIE($G(IBFLGS),"IBFDA","IBSSI","IBERR")
I $D(IBERR) D BMES^XPDUTL(IBERR("DIERR",1,"TEXT",1)) Q -1 ;D BMES^XPDUTL(IBERR("DIERR",1,"TEXT",1))
Q +$G(IBSSI(1))
;
;
;fill fields
;Input:
;FILENO file number
;FLDNO field number
;RECIEN ien string
;NEWVAL new value to file
;Output:
;0^ NEWVAL^error if failure
;1^ NEWVAL if success
FILLFLDS(FILENO,FLDNO,RECIEN,NEWVAL) ;
N RECIENS,FDA,ERRARR
S RECIENS=RECIEN_","
S FDA(FILENO,RECIENS,FLDNO)=NEWVAL
D FILE^DIE("","FDA","ERRARR")
I $D(ERRARR) Q "0^"_NEWVAL_"^"_ERRARR("DIERR",1,"TEXT",1)
Q "1^"_NEWVAL
;
;convert external value of the field EVENT TYPE to its internal value
;IA# 10155
EXT2INT(IBEXTRN) ;
N IBDD,IBZ,IBCNT,IBINTERN
S IBINTERN=-1
S IBDD=$P($G(^DD(366.141,.01,0)),U,3) ;IA# 10155
F IBCNT=1:1 S IBZ=$P(IBDD,";",IBCNT) Q:IBZ="" D Q:IBINTERN'<0
. I $P(IBZ,":",2)=IBEXTRN S IBINTERN=+IBZ
Q:IBINTERN<0 0 ;treat as UNKNOWN
Q IBINTERN
;
;
;should RX copay from the entry in file #350 be placed on hold ?
;called from HOLD^IBRUTL
;Input:
; X - zeroth node of file #350 entry
;output:
; 0 - NO - DO NOT PUT ON HOLD
; 1 - this is RX copay but there is no ECME claim, so process it as usual
; 1 - this is ECME RX copay and it should be put on HOLD
; 1 - this is ECME RX copay and it was rejected or reversed
; 2 - this is not RX copay
HOLDECME(X) ;
N IBRXIEN,IBREFNO,IBRXZ,IBDATE,IBDFN,IBEBCOB,IBRETVAL
S IBRETVAL=""
S IBRXZ=$P($G(X),U,4),(IBRXIEN,IBREFNO)=0
I $P($P(IBRXZ,";"),":")'=52 Q 2 ;follow pre-existing logic
S IBRXIEN=+$P($P(IBRXZ,";"),":",2) ;ien in file #52
S IBREFNO=+$P($P($P(X,U,4),";",2),":",2) ;refill number (0 - for original)
S IBDFN=+$P($G(X),U,2) ;Patient ien
;if this is OTC "non-e-billable" drug then DO NOT PUT ON HOLD
I $$OTCNEBIL(IBRXIEN,IBREFNO)=1 Q 0
;if this is non-OTC drug OR if this is OTC drug but marked as e-billable then look if it has zero amount paid
I $$AMNTHOLD^IBNCPUT1(IBDFN,IBRXIEN,IBREFNO)=0 Q 0 ;DO NOT PUT ON HOLD
Q 1 ;follow pre-existing logic
;
;should RX copay be placed on hold based on the PAID amount?
;input:
; IBDFN - patient's ien
; IBRX - file #52 ien
; IBREF - refill no
;output:
; 1 - YES
; 0 - NO
AMNTHOLD(IBDFN,IBRX,IBREF) ;
N IBPAYRES ;for payer's response
N IBADT
;
S IBPAYRES=$$PAIDAMNT^BPSUTIL(IBRX,IBREF)
;if payable AND amount paid is zero AND does not have any other Pharmacy insurance
;THEN return NO - it should not be put on hold
I +IBPAYRES=1,$P(IBPAYRES,U,2)=0,'$$MOREINS^IBNCPNB(IBDFN,+$P(IBPAYRES,U,3)) Q 0
Q 1
;Is this RX for OTC drug which is NOT E-billiable?
;Input:
; IBRX - ien in file #52
; IBREFNO - fill#
;Output:
; 1 - this is OTC drug and it is NOT marked as e-billable
; 0 - otherwise
OTCNEBIL(IBRX,IBREFNO) ;
N ARR,IBSPHNDL,IBDRUG,IBELIG
S IBDRUG=+$$RXAPI1^IBNCPUT1(IBRX,6,"I")
S IBSPHNDL=$$DRUGDIE^IBNCPUT1(IBDRUG,3,"E",.ARR)
I IBSPHNDL'["9" Q 0 ;this is not OTC drug
S IBELIG=$S('IBREFNO:$$FILE^IBRXUTL(IBRX,85),1:$$SUBFILE^IBRXUTL(IBRX,IBREFNO,52,85))
I $$BILLABLE^IBNCPDP(IBDRUG,IBELIG) Q 0 ; it is an OTC e-billable drug
;it is OTC NON E-billable drug
Q 1
;
;Function to return field data from DRUG file (#50)
; Parameters
; IBIEN50 - IEN of DRUG FILE #50
; IBFLDN - Field Number(s) (like .01)
; IBEXIN - Specifies internal or external value of returned field
; - optional, defaults to "I"
; IBARR50 - Array to return value(s). Optional. Pass by reference.
; See EN^DIQ documentation for variable DIQ
;
; Function returns field data if one field is specified. If
; multiple fields, the function will return "" and the field
; values are returned in IBARR50
; Example: W $$DRUGDIE^IBNCPUT1(134,25,"E",.ARR)
DRUGDIE(IBIEN50,IBFLDN,IBEXIN,IBARR50) ; Return field values for Drug file
I $G(IBIEN50)=""!($G(IBFLDN)="") Q ""
N DIQ,PSSDIY
N IBDIQ
I $G(IBEXIN)'="E" S IBEXIN="I"
S IBDIQ="IBARR50",IBDIQ(0)=IBEXIN
D EN^PSSDI(50,"IB",50,.IBFLDN,.IBIEN50,.IBDIQ)
Q $G(IBARR50(50,IBIEN50,IBFLDN,IBEXIN))
;
;/*
;Function to return a value for a SINGLE field of file #52
;DBIA 4858
;input:
; IBIEN52 - ien of file #52
; IBFLDN - one single field, for example ".01"
; IBFORMAT -
; "E" for external format
; "I" - internal
; "N" - do not return nulls
; default is "E"
;output:
; returns a field value or null (empty string)
; examples:
;W $$RXAPI1^IBNCPUT1(504733,6,"E")
;ALBUMIN 25% 50ML
;W $$RXAPI1^IBNCPUT1(504733,6,"I")
;134
RXAPI1(IBIEN52,IBFLDN,IBFORMAT) ;*/
N DIQ,DIC,IBARR,X,Y,D0,PSODIY
N I,J,C,DA,DRS,DIL,DI,DIQ1
N IBDIQ
S IBDIQ="IBARR"
S IBDIQ(0)=$S($G(IBFORMAT)="":"E",1:IBFORMAT)
D DIQ^PSODI(52,52,.IBFLDN,.IBIEN52,.IBDIQ) ;DBIA 4858
Q $S(IBDIQ(0)="N":$G(IBARR(52,IBIEN52,IBFLDN)),1:$G(IBARR(52,IBIEN52,IBFLDN,IBDIQ(0))))
;
;
;IBNCPUT1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPUT1 6632 printed Sep 23, 2025@20:01:25 Page 2
IBNCPUT1 ;BHAM ISC/SS - IB NCPDP UTILITIES ;22-MAR-2006
+1 ;;2.0;INTEGRATED BILLING;**342,363,384,550**;21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Utilities for NPCDP
+5 ;/**
+6 ;Creates a new entry in the file or subfile with .01 field
+7 ;IBFILE - file/subfile #
+8 ;IBIEN - ien of the parent file entry in which the new subfile entry will be inserted
+9 ;IBVAL01 - .01 value for the new entry
+10 ;NEWRECNO -(optional) specify IEN if you want specific value
+11 ; Note: if "" then the system will assign the entry number itself.
+12 ;IBFLGS - FLAGS parameter for UPDATE^DIE
+13 ;
+14 ;Examples
+15 ;top level:
+16 ; INSITEM(366.14,"",IBDATE,"")
+17 ; INSITEM(366.14,"",IBDATE,45)
+18 ;
+19 ;1st level multiple:
+20 ; subfile number = #366.141
+21 ; parent file #366.14 entry number = 345
+22 ; INSITEM(366.141,345,"SUBMIT","")
+23 ; to create mupltiple entry with particular entry number = 23
+24 ; INSITEM(366.141,345,"SUBMIT",23)
+25 ;
+26 ;2nd level multiple
+27 ;parent file #366.14 entry number = 234
+28 ;parent multiple entry number = 55
+29 ;create mupltiple entry INSURANCE
+30 ; INSITEM(366.1412,"55,234","INS","")
+31 ; results in :
+32 ; ^IBCNR(366.14,234,1,55,5,0)=^366.1412PA^1^1
+33 ; ^IBCNR(366.14,234,1,55,5,1,0)=INS
+34 ; ^IBCNR(366.14,234,1,55,5,"B","INS",1)=
+35 ; (DD node for this muptiple =5 )
+36 ;
+37 ;output :
+38 ; positive number - record # created
+39 ; <=0 - failure
+40 ; See description above
INSITEM(IBFILE,IBIEN,IBVAL01,NEWRECNO,IBFLGS) ;*/
+1 NEW IBSSI,IBIENS,IBFDA,IBERR
+2 IF '$GET(NEWRECNO)
NEW NEWRECNO
SET NEWRECNO=$GET(NEWRECNO)
+3 IF IBIEN'=""
SET IBIENS="+1,"_IBIEN_","
IF $LENGTH(NEWRECNO)>0
SET IBSSI(1)=+NEWRECNO
+4 IF IBIEN=""
SET IBIENS="+1,"
IF $LENGTH(NEWRECNO)>0
SET IBSSI(1)=+NEWRECNO
+5 SET IBFDA(IBFILE,IBIENS,.01)=IBVAL01
+6 DO UPDATE^DIE($GET(IBFLGS),"IBFDA","IBSSI","IBERR")
+7 ;D BMES^XPDUTL(IBERR("DIERR",1,"TEXT",1))
IF $DATA(IBERR)
DO BMES^XPDUTL(IBERR("DIERR",1,"TEXT",1))
QUIT -1
+8 QUIT +$GET(IBSSI(1))
+9 ;
+10 ;
+11 ;fill fields
+12 ;Input:
+13 ;FILENO file number
+14 ;FLDNO field number
+15 ;RECIEN ien string
+16 ;NEWVAL new value to file
+17 ;Output:
+18 ;0^ NEWVAL^error if failure
+19 ;1^ NEWVAL if success
FILLFLDS(FILENO,FLDNO,RECIEN,NEWVAL) ;
+1 NEW RECIENS,FDA,ERRARR
+2 SET RECIENS=RECIEN_","
+3 SET FDA(FILENO,RECIENS,FLDNO)=NEWVAL
+4 DO FILE^DIE("","FDA","ERRARR")
+5 IF $DATA(ERRARR)
QUIT "0^"_NEWVAL_"^"_ERRARR("DIERR",1,"TEXT",1)
+6 QUIT "1^"_NEWVAL
+7 ;
+8 ;convert external value of the field EVENT TYPE to its internal value
+9 ;IA# 10155
EXT2INT(IBEXTRN) ;
+1 NEW IBDD,IBZ,IBCNT,IBINTERN
+2 SET IBINTERN=-1
+3 ;IA# 10155
SET IBDD=$PIECE($GET(^DD(366.141,.01,0)),U,3)
+4 FOR IBCNT=1:1
SET IBZ=$PIECE(IBDD,";",IBCNT)
if IBZ=""
QUIT
Begin DoDot:1
+5 IF $PIECE(IBZ,":",2)=IBEXTRN
SET IBINTERN=+IBZ
End DoDot:1
if IBINTERN'<0
QUIT
+6 ;treat as UNKNOWN
if IBINTERN<0
QUIT 0
+7 QUIT IBINTERN
+8 ;
+9 ;
+10 ;should RX copay from the entry in file #350 be placed on hold ?
+11 ;called from HOLD^IBRUTL
+12 ;Input:
+13 ; X - zeroth node of file #350 entry
+14 ;output:
+15 ; 0 - NO - DO NOT PUT ON HOLD
+16 ; 1 - this is RX copay but there is no ECME claim, so process it as usual
+17 ; 1 - this is ECME RX copay and it should be put on HOLD
+18 ; 1 - this is ECME RX copay and it was rejected or reversed
+19 ; 2 - this is not RX copay
HOLDECME(X) ;
+1 NEW IBRXIEN,IBREFNO,IBRXZ,IBDATE,IBDFN,IBEBCOB,IBRETVAL
+2 SET IBRETVAL=""
+3 SET IBRXZ=$PIECE($GET(X),U,4)
SET (IBRXIEN,IBREFNO)=0
+4 ;follow pre-existing logic
IF $PIECE($PIECE(IBRXZ,";"),":")'=52
QUIT 2
+5 ;ien in file #52
SET IBRXIEN=+$PIECE($PIECE(IBRXZ,";"),":",2)
+6 ;refill number (0 - for original)
SET IBREFNO=+$PIECE($PIECE($PIECE(X,U,4),";",2),":",2)
+7 ;Patient ien
SET IBDFN=+$PIECE($GET(X),U,2)
+8 ;if this is OTC "non-e-billable" drug then DO NOT PUT ON HOLD
+9 IF $$OTCNEBIL(IBRXIEN,IBREFNO)=1
QUIT 0
+10 ;if this is non-OTC drug OR if this is OTC drug but marked as e-billable then look if it has zero amount paid
+11 ;DO NOT PUT ON HOLD
IF $$AMNTHOLD^IBNCPUT1(IBDFN,IBRXIEN,IBREFNO)=0
QUIT 0
+12 ;follow pre-existing logic
QUIT 1
+13 ;
+14 ;should RX copay be placed on hold based on the PAID amount?
+15 ;input:
+16 ; IBDFN - patient's ien
+17 ; IBRX - file #52 ien
+18 ; IBREF - refill no
+19 ;output:
+20 ; 1 - YES
+21 ; 0 - NO
AMNTHOLD(IBDFN,IBRX,IBREF) ;
+1 ;for payer's response
NEW IBPAYRES
+2 NEW IBADT
+3 ;
+4 SET IBPAYRES=$$PAIDAMNT^BPSUTIL(IBRX,IBREF)
+5 ;if payable AND amount paid is zero AND does not have any other Pharmacy insurance
+6 ;THEN return NO - it should not be put on hold
+7 IF +IBPAYRES=1
IF $PIECE(IBPAYRES,U,2)=0
IF '$$MOREINS^IBNCPNB(IBDFN,+$PIECE(IBPAYRES,U,3))
QUIT 0
+8 QUIT 1
+9 ;Is this RX for OTC drug which is NOT E-billiable?
+10 ;Input:
+11 ; IBRX - ien in file #52
+12 ; IBREFNO - fill#
+13 ;Output:
+14 ; 1 - this is OTC drug and it is NOT marked as e-billable
+15 ; 0 - otherwise
OTCNEBIL(IBRX,IBREFNO) ;
+1 NEW ARR,IBSPHNDL,IBDRUG,IBELIG
+2 SET IBDRUG=+$$RXAPI1^IBNCPUT1(IBRX,6,"I")
+3 SET IBSPHNDL=$$DRUGDIE^IBNCPUT1(IBDRUG,3,"E",.ARR)
+4 ;this is not OTC drug
IF IBSPHNDL'["9"
QUIT 0
+5 SET IBELIG=$SELECT('IBREFNO:$$FILE^IBRXUTL(IBRX,85),1:$$SUBFILE^IBRXUTL(IBRX,IBREFNO,52,85))
+6 ; it is an OTC e-billable drug
IF $$BILLABLE^IBNCPDP(IBDRUG,IBELIG)
QUIT 0
+7 ;it is OTC NON E-billable drug
+8 QUIT 1
+9 ;
+10 ;Function to return field data from DRUG file (#50)
+11 ; Parameters
+12 ; IBIEN50 - IEN of DRUG FILE #50
+13 ; IBFLDN - Field Number(s) (like .01)
+14 ; IBEXIN - Specifies internal or external value of returned field
+15 ; - optional, defaults to "I"
+16 ; IBARR50 - Array to return value(s). Optional. Pass by reference.
+17 ; See EN^DIQ documentation for variable DIQ
+18 ;
+19 ; Function returns field data if one field is specified. If
+20 ; multiple fields, the function will return "" and the field
+21 ; values are returned in IBARR50
+22 ; Example: W $$DRUGDIE^IBNCPUT1(134,25,"E",.ARR)
DRUGDIE(IBIEN50,IBFLDN,IBEXIN,IBARR50) ; Return field values for Drug file
+1 IF $GET(IBIEN50)=""!($GET(IBFLDN)="")
QUIT ""
+2 NEW DIQ,PSSDIY
+3 NEW IBDIQ
+4 IF $GET(IBEXIN)'="E"
SET IBEXIN="I"
+5 SET IBDIQ="IBARR50"
SET IBDIQ(0)=IBEXIN
+6 DO EN^PSSDI(50,"IB",50,.IBFLDN,.IBIEN50,.IBDIQ)
+7 QUIT $GET(IBARR50(50,IBIEN50,IBFLDN,IBEXIN))
+8 ;
+9 ;/*
+10 ;Function to return a value for a SINGLE field of file #52
+11 ;DBIA 4858
+12 ;input:
+13 ; IBIEN52 - ien of file #52
+14 ; IBFLDN - one single field, for example ".01"
+15 ; IBFORMAT -
+16 ; "E" for external format
+17 ; "I" - internal
+18 ; "N" - do not return nulls
+19 ; default is "E"
+20 ;output:
+21 ; returns a field value or null (empty string)
+22 ; examples:
+23 ;W $$RXAPI1^IBNCPUT1(504733,6,"E")
+24 ;ALBUMIN 25% 50ML
+25 ;W $$RXAPI1^IBNCPUT1(504733,6,"I")
+26 ;134
RXAPI1(IBIEN52,IBFLDN,IBFORMAT) ;*/
+1 NEW DIQ,DIC,IBARR,X,Y,D0,PSODIY
+2 NEW I,J,C,DA,DRS,DIL,DI,DIQ1
+3 NEW IBDIQ
+4 SET IBDIQ="IBARR"
+5 SET IBDIQ(0)=$SELECT($GET(IBFORMAT)="":"E",1:IBFORMAT)
+6 ;DBIA 4858
DO DIQ^PSODI(52,52,.IBFLDN,.IBIEN52,.IBDIQ)
+7 QUIT $SELECT(IBDIQ(0)="N":$GET(IBARR(52,IBIEN52,IBFLDN)),1:$GET(IBARR(52,IBIEN52,IBFLDN,IBDIQ(0))))
+8 ;
+9 ;
+10 ;IBNCPUT1
