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

IBNCPUT1.m

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