- 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 Jan 18, 2025@03:26:18 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