source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBNCPUT1.m@ 1397

IBNCPUT1 ;BHAM ISC/SS - IB NCPDP UTILITIES ;22-MAR-2006
 ;;2.0;INTEGRATED BILLING;**342,363**;21-MAR-94;Build 35
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
 ;Utilities for NPCDP
 ;/**
 ;Creates a new entry (or node for multiple with .01 field)
 ;
 ;IBFILE - subfile# (9002313.59111) for comment
 ;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: "" then the system will assign the entry number itself.
 ;IBFLGS - FLAGS parameter for UPDATE^DIE
 ;Examples
 ;top level:
 ; D INSITEM(366.14,"",IBDATE,"")
 ; D INSITEM(366.14,"",IBDATE,45)
 ; 
 ;1st level multiple:
 ; subfile number = #366.141
 ; parent file #366.14 entry number = 345
 ; D INSITEM(366.141,345,"SUBMIT","")
 ; to create mupltiple entry with particular entry number = 23
 ; D 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
 ; D 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)=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
 ;Output:
 ; 1 - this is OTC drug and it is NOT marked as e-billable
 ; 0 - otherwise
OTCNEBIL(IBRX) ;
 N ARR,IBSPHNDL,IBDRUG
 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
 I IBSPHNDL["E" Q 0  ;it is 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