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

IBNCPLOG.m

Go to the documentation of this file. 
  1. IBNCPLOG ;BHAM ISC/SS - IB ECME EVNT REPORT ;3/5/08  14:02
  1.  ;;2.0;INTEGRATED BILLING;**342,339,363,383,411,435,452,534,550,647**;21-MAR-94;Build 10
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;store data related to the IB calls made by ECME package in the file #366.14
  1.  ;input:
  1.  ;.IBIBD - (by reference) IBD array with parameter sent to IB by ECME
  1.  ;DFN patient's ien
  1.  ;IBPROC - type of event. i.e. content of CALL such as BILL, REJECT and so on
  1.  ;IBRESULT - (optional) result of the event processing, format: return_code^message
  1.  ;IBJOB - (optional) job, default = $J
  1.  ;IBDTTM - (optional) datetime, default = "NOW"
  1.  ;IBUSR - (optional) user ID, default = DUZ
  1.  ;output:
  1.  ;none
  1. LOG(IBIBD,DFN,IBPROC,IBRESULT,IBJOB,IBDTTM,IBUSR) ;Store the data
  1.  N NDX,Z,REF,IBDATE,IBDTIEN,IBEVNIEN,IBIBDTYP,IBRETV,IBPTR
  1.  S IBRESULT=$G(IBRESULT)
  1.  ;
  1.  I '$G(IBJOB) S IBJOB=$J
  1.  I '$G(IBDTTM) S IBDTTM=$$NOW^XLFDT()
  1.  I '$G(IBUSR) S IBUSR=+DUZ
  1.  ;
  1.  S IBDATE=DT
  1.  S IBDTIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
  1.  L +^IBCNR(366.14):30 E  Q
  1.  I IBDTIEN=0 S IBDTIEN=+$$ADDDATE(IBDATE)
  1.  ;create an event
  1.  S IBEVNIEN=$$NEWEVENT(IBDTIEN,IBPROC)
  1.  L -^IBCNR(366.14)
  1.  I IBEVNIEN=0 W !,"New event creation Error : LOG^IBNCPLOG",! Q
  1.  ;
  1.  I +$$FILLFLDS^IBNCPUT1(366.141,".03",IBEVNIEN_","_IBDTIEN,DFN) ;DFN
  1.  I +$$FILLFLDS^IBNCPUT1(366.141,".04",IBEVNIEN_","_IBDTIEN,IBJOB) ;JOB
  1.  I +$$FILLFLDS^IBNCPUT1(366.141,".05",IBEVNIEN_","_IBDTIEN,IBDTTM) ;DATETIME
  1.  I +$$FILLFLDS^IBNCPUT1(366.141,".06",IBEVNIEN_","_IBDTIEN,DUZ) ;USER
  1.  I IBRESULT'="" D
  1.  . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".07",IBEVNIEN_","_IBDTIEN,+IBRESULT) ;RESULT
  1.  . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".08",IBEVNIEN_","_IBDTIEN,$P(IBRESULT,U,2)) ;RESULT MESSAGE
  1.  . I IBPROC="BILLABLE STATUS CHECK",$P(IBRESULT,U,2)]"" D
  1.  .. S IBPTR=$$GETREAS($P(IBRESULT,U,2))
  1.  .. I IBPTR S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".02",IBEVNIEN_","_IBDTIEN,IBPTR) ; Non-Billable Status Reason
  1.  . I $P(IBRESULT,U,3)'="" S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,"7.05",IBEVNIEN_","_IBDTIEN,$P(IBRESULT,U,3)) ; Eligibility from IB billing determination (IB*2*452)
  1.  . Q
  1.  ;
  1.  ;store IBIBD array
  1.  S IBIBDTYP=""
  1.  F  S IBIBDTYP=$O(IBIBD(IBIBDTYP)) Q:IBIBDTYP=""  D
  1.  . D IBD(IBDTIEN,IBEVNIEN,IBIBDTYP,$G(IBIBD(IBIBDTYP)),.IBIBD)
  1.  ;store "INS" node of IBIBD array
  1.  I $D(IBIBD("INS")) I $$INS(.IBIBD,IBDTIEN,IBEVNIEN)
  1.  Q
  1.  ;
  1.  ;store IBD array data
  1.  ;IBDTIEN -  ien on top [DATE] level
  1.  ;IBRECNO - ien in [EVENTS] multiple
  1.  ;IBIBDTYP - type subscript in IBD array (BILL, PAID, RESPONSE, etc)
  1.  ;IBVAL - value to store
  1.  ;IBIBD - array with data passed by reference (for efficiency)
  1. IBD(IBDTIEN,IBRECNO,IBIBDTYP,IBVAL,IBIBD) ;
  1.  N IBFLDNO
  1.  ;W !," - ",IBRECNO," ",IBIBDTYP," = ",IBVAL
  1.  ;free text like "WEBMD: PAID"
  1.  I IBIBDTYP="AUTH #" S IBFLDNO=".11",IBVAL=$E(IBVAL,1,30) G EDITIBD
  1.  ;free text like "0504597;3051229"
  1.  I IBIBDTYP="BCID" S IBFLDNO=".12" G EDITIBD
  1.  ;7 or 12 digit ECME number - identifier (stored as a text - might have leading zeroes)
  1.  I IBIBDTYP="CLAIMID" S IBFLDNO=".13" G EDITIBD
  1.  ;pointer to file #2
  1.  I IBIBDTYP="DFN" S IBFLDNO=".14" G EDITIBD
  1.  ;pointer to file #40.8
  1.  I IBIBDTYP="DIVISION" S IBFLDNO=".15" G EDITIBD
  1.  ;free text
  1.  I IBIBDTYP="RESPONSE" S IBFLDNO=".16",IBVAL=$E(IBVAL,1,20) G EDITIBD
  1.  ;free text
  1.  I IBIBDTYP="REVERSAL REASON" S IBFLDNO=".17",IBVAL=$E(IBVAL,1,40) G EDITIBD
  1.  ;1 digit number
  1.  I IBIBDTYP="RTS-DEL" S IBFLDNO=".18" G EDITIBD
  1.  ;free text
  1.  I IBIBDTYP="STATUS" S IBFLDNO=".19",IBVAL=$E(IBVAL,1,20) G EDITIBD
  1.  ;Prescription number as a text, might have alpha characters (external value, this is not IEN)
  1.  I IBIBDTYP="RX NO" S IBFLDNO=".202",IBVAL=$E(IBVAL,1,20) G EDITIBD
  1.  ;0 - original, 1,2,3,... - refill number
  1.  I IBIBDTYP="FILL NUMBER" S IBFLDNO=".203" G EDITIBD
  1.  ;internal identifier number for a DRUG
  1.  I IBIBDTYP="DRUG" S IBFLDNO=".204" G EDITIBD
  1.  I IBIBDTYP="NDC" S IBFLDNO=".205" G EDITIBD
  1.  I IBIBDTYP="DOS" S IBFLDNO=".206" G EDITIBD
  1.  I IBIBDTYP="RELEASE DATE" S IBFLDNO=".207" G EDITIBD
  1.  I IBIBDTYP="QTY" S IBFLDNO=".208" G EDITIBD
  1.  I IBIBDTYP="UNITS" S IBFLDNO=".213" G EDITIBD
  1.  I IBIBDTYP="NCPDP QTY" S IBFLDNO=".214" G EDITIBD
  1.  I IBIBDTYP="NCPDP UNITS" S IBFLDNO=".215" G EDITIBD
  1.  I IBIBDTYP="DAYS SUPPLY" S IBFLDNO=".209" G EDITIBD
  1.  I IBIBDTYP="DEA" S IBFLDNO=".21" G EDITIBD
  1.  I IBIBDTYP="FILLED BY" S IBFLDNO=".211" G EDITIBD
  1.  I IBIBDTYP="COPAY" S IBFLDNO=".311" G EDITIBD
  1.  I IBIBDTYP="ING COST PAID" S IBFLDNO=".312" G EDITIBD
  1.  I IBIBDTYP="DISP FEE PAID" S IBFLDNO=".313" G EDITIBD
  1.  I IBIBDTYP="PAT RESP" S IBFLDNO=".314" G EDITIBD
  1.  ; for environmental indicators:
  1.  ; if IBIBD("SC/EI OVR")=1 - the user overrides any answers (3)
  1.  ; if $G(IBIBD("SC/EI NO ANSW")) contains the IBIBDTYP - this question was not answered (2)
  1.  ; otherwise - use whatever in the IBVAL (0 - NO, 1 -YES)
  1.  I IBIBDTYP="AO" S IBFLDNO=".401",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="CV" S IBFLDNO=".402",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="SWA" S IBFLDNO=".403",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="IR" S IBFLDNO=".404",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="MST" S IBFLDNO=".405",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="HNC" S IBFLDNO=".406",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="SC" S IBFLDNO=".407",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="SHAD" S IBFLDNO=".408",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
  1.  I IBIBDTYP="ACT DTY OVR" S IBFLDNO=".409" G EDITIBD
  1.  I IBIBDTYP="BILL" S IBFLDNO=".301" G EDITIBD
  1.  I IBIBDTYP="BILLED" S IBFLDNO=".302" G EDITIBD
  1.  I IBIBDTYP="PLAN" S IBFLDNO=".303" G EDITIBD
  1.  I IBIBDTYP="COST" S IBFLDNO=".304" G EDITIBD
  1.  I IBIBDTYP="PAID" S IBFLDNO=".305" G EDITIBD
  1.  I IBIBDTYP="CLOSE COMMENT" S IBFLDNO=".306" G EDITIBD
  1.  I IBIBDTYP="REOPEN COMMENT" S IBFLDNO=".306" G EDITIBD
  1.  I IBIBDTYP="CLOSE REASON" S IBFLDNO=".307" G EDITIBD
  1.  I IBIBDTYP="DROP TO PAPER" S IBFLDNO=".308" G EDITIBD
  1.  I IBIBDTYP="RELEASE COPAY" S IBFLDNO=".309" G EDITIBD
  1.  I IBIBDTYP="USER" S IBFLDNO=".31" G EDITIBD
  1.  I IBIBDTYP="PRESCRIPTION" S IBFLDNO=".201" G EDITIBD
  1.  I IBIBDTYP="IEN" S IBFLDNO=".212" G EDITIBD
  1.  I IBIBDTYP="EPHARM" S IBFLDNO=".09" G EDITIBD
  1.  I IBIBDTYP="RXCOB" S IBFLDNO="7.01" G EDITIBD
  1.  I IBIBDTYP="PRIMARY BILL" S IBFLDNO="7.02" G EDITIBD
  1.  I IBIBDTYP="PRIOR PAYMENT" S IBFLDNO="7.03" G EDITIBD
  1.  I IBIBDTYP="RTYPE" S IBFLDNO="7.04" G EDITIBD
  1.  I IBIBDTYP="DRUG-BILLABLE" S IBFLDNO=7.06 G EDITIBD
  1.  I IBIBDTYP="DRUG-BILLABLE TRICARE" S IBFLDNO=7.07 G EDITIBD
  1.  I IBIBDTYP="DRUG-BILLABLE CHAMPVA" S IBFLDNO=7.08 G EDITIBD
  1.  I IBIBDTYP="DRUG-SENSITIVE DX" S IBFLDNO=7.09 G EDITIBD
  1.  Q 0
  1. EDITIBD ;
  1.  Q +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
  1.  ;------
  1.  ;to store IBD("INS") array data
  1.  ;input:
  1.  ;IBDARR - IBD array by reference
  1.  ;IBDTIEN -  ien on top [DATE] level
  1.  ;IBRECNO - ien in [EVENTS] multiple
  1.  ;output:
  1.  ; record number if success
  1.  ; 0 if failure
  1. INS(IBDARR,IBDTIEN,IBRECNO) ;
  1.  N IBSET1,IBSET2,IBSET3,IBFLDNO,IBINSNO,RECNO,IBVAL
  1.  S IBINSNO=0
  1.  ; Only create entry for first insurance found. BNT 07/07/2010
  1.  F  S IBINSNO=$O(IBDARR("INS",IBINSNO)) Q:+IBINSNO=0  D  Q:$D(RECNO)
  1.  . S IBSET1=$G(IBDARR("INS",IBINSNO,1))
  1.  . S IBSET2=$G(IBDARR("INS",IBINSNO,2))
  1.  . S IBSET3=$G(IBDARR("INS",IBINSNO,3))
  1.  . S RECNO=$$ADDINS(IBDTIEN,IBRECNO)
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.02,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,1))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.03,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,2))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.04,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,3))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.05,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,4))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.06,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,5))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.07,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,6))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.08,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,7))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.09,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,20))
  1.  . ;
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.101,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,8))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.102,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,9))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.103,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,10))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.104,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,11))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.105,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,12))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.106,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,13))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.107,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,14))
  1.  . ;
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.201,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,1))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.202,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,2))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.203,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,3))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.204,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,4))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.205,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,5))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.206,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,6))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.207,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,7))
  1.  . ;
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.301,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,1))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.302,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,2))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.303,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,3))
  1.  . I +$$FILLFLDS^IBNCPUT1(366.1412,.304,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,7))
  1.  . Q
  1.  ;
  1.  Q RECNO
  1.  ;create top level entry in #366.14
  1.  ;input:
  1.  ; IBDATE - date in FileMan format
  1.  ;output
  1.  ; returns ien created
  1. ADDDATE(IBDATE) ;
  1.  N IBIEN
  1.  S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
  1.  I IBIEN>0 Q IBIEN
  1.  I $$INSITEM^IBNCPUT1(366.14,"",IBDATE,"")
  1.  Q +$O(^IBCNR(366.14,"B",IBDATE,0))
  1.  ;
  1.  ;create EVENT entry in #366.14
  1.  ;input:
  1.  ;IBIEN - ien on top [DATE] level
  1.  ;EVNTTYPE event type (value for .01)
  1.  ;returns ien for the event
  1.  ;or 0 if failed
  1. NEWEVENT(IBIEN,EVNTTYPE) ;
  1.  N EVNTRECN
  1.  S EVNTRECN=$$INSITEM^IBNCPUT1(366.141,IBIEN,$$EXT2INT^IBNCPUT1(EVNTTYPE),"","")
  1.  I EVNTRECN>0 Q EVNTRECN
  1.  Q 0
  1.  ;
  1.  ;add insurance node
  1.  ;IBDTIEN - ien on top [DATE] level
  1.  ;IBEVIEN - ien in [EVENTS] multiple
  1.  ;returns :
  1.  ; new ien in INSURANCE multiple
  1. ADDINS(IBDTIEN,IBEVIEN) ;
  1.  N IBX,IBX2
  1.  F IBX=1:1:99999 I '$D(^IBCNR(366.14,IBDTIEN,1,IBEVIEN,5,IBX)) D  Q
  1.  . S IBX2=$$INSITEM^IBNCPUT1(366.1412,IBEVIEN_","_IBDTIEN,IBX,IBX)
  1.  Q +$O(^IBCNR(366.14,IBDTIEN,1,IBEVIEN,5,"B",IBX,0))
  1.  ;
  1. GETREAS(REASON) ;
  1.  ; Get the pointer of the IB NCPDP NON-BILLABLE REASON file - Create the 
  1.  ;   entry if needed.
  1.  ;
  1.  ; Input:
  1.  ;   REASON: Non-billable reason text
  1.  ; Output:
  1.  ;   IEN of the IB NCPPD NON-BILLABLE REASON file
  1.  ;
  1.  I $G(REASON)="" Q ""
  1.  N NBSTS,DIC,X,Y,DTOUT,DUOUT
  1.  ;
  1.  ; Make uppercase and less than 60 characters
  1.  S REASON=$TR($E($$UP^XLFSTR(REASON),1,60),"^")
  1.  I $E(REASON,$L(REASON))="." S REASON=$E(REASON,1,$L(REASON)-1)
  1.  ;
  1.  ; Check if it already exists.  If so, return the IEN
  1.  S NBSTS=$O(^IBCNR(366.17,"B",REASON,""))
  1.  I NBSTS Q NBSTS
  1.  ;
  1.  ; If it does not exist not, add to the dictionary
  1.  S DIC="^IBCNR(366.17,",DIC(0)="F",X=REASON
  1.  D FILE^DICN
  1.  I Y=-1 Q ""
  1.  Q +Y