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

IBOSCDC1.m

Go to the documentation of this file. 
  1. IBOSCDC1 ;ALB/BNT - SERVICE CONNECTED DETERMINATION CHANGE REPORT UTILITIES ;10/04/07
  1.  ;;2.0;INTEGRATED BILLING;**384,435**;21-MAR-94;Build 27
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;Patient info for header
  1.  ;Input:
  1.  ;IBDFN = Patient DFN
  1.  ;IBLEN = Length of overall characters for output
  1.  ;Returns:
  1.  ;Left Justified patient name with Last 4 SSN
  1. PATINF(IBDFN,IBLEN) ;
  1.  N X
  1.  S X=$$PATNAME(IBDFN,IBLEN-7)_" "_$$SSN4^IBNCPRR1(IBDFN)
  1.  Q $$LJ(X,IBLEN) ;name
  1.  ;
  1.  ;Get patient's name
  1.  ;Input:
  1.  ;IBDFN = Patient DFN
  1.  ;IBLEN = Length of characters to return
  1.  ;Returns:
  1.  ;patient's name
  1. PATNAME(IBDFN,IBLEN) ;
  1.  Q $E($P($G(^DPT(IBDFN,0)),U),1,IBLEN)
  1.  ;
  1.  ;left justified, blank padded
  1.  ;adds spaces on right or truncates to make return string IBLEN characters long
  1.  ;IBST- original string
  1.  ;IBLEN - desired length
  1. LJ(IBST,IBLEN) ;
  1.  N IBL
  1.  S IBL=IBLEN-$L(IBST)
  1.  Q $E(IBST_$J("",$S(IBL<0:0,1:IBL)),1,IBLEN)
  1.  ;
  1.  ;Get Third Party bill from file 362.4, if one exists
  1.  ;IBRXN = RX number
  1.  ;IBDT = RX Fill Date
  1.  ;Returns the Bill Number
  1. BILL(IBRXN,IBDT) ;Bill IEN (if any) or null
  1.  N RES,X,IBZ
  1.  S IBDT=$P(IBDT,".")
  1.  S RES=""
  1.  S X="" F  S X=$O(^IBA(362.4,"B",IBRXN,X),-1) Q:X=""  D:X  Q:RES
  1.  . S IBZ=$G(^IBA(362.4,X,0))
  1.  . I $P($P(IBZ,U,3),".")=IBDT,$P(IBZ,U,2) S RES=+$P(IBZ,U,2)
  1.  Q RES
  1.  ;
  1.  ;Check if the status on the first party bill in 350 is CANCELLED?
  1.  ;IBILL = IEN from file 350
  1.  ;Returns 1=yes, 0=no
  1. BILLCNCL(IBILL) ;
  1.  N IBBILSTS
  1.  Q:(IBILL="")!(IBILL=0) 1
  1.  Q $S($$BILLSTS(IBILL)["CANCEL":1,1:0)
  1.  ;
  1.  ;Returns the PRINT NAME of the STATUS associated with a bill
  1.  ;IBILL = IEN from file 350
  1.  ;Returns the PRINT NAME field from file 350.21
  1. BILLSTS(IBILL) ;
  1.  N IBBILSTS
  1.  Q:(IBILL="")!(IBILL=0) ""
  1.  S IBBILSTS=+$P($G(^IB(IBILL,0)),U,5)
  1.  Q $P($G(^IBE(350.21,IBBILSTS,0)),U,2)
  1.  ;
  1.  ;Get the TOTAL CHARGE for the bill
  1.  ;IBILL = IEN from file 350
  1.  ;Returns the TOTAL CHARGE 
  1. BILLAMNT(IBILL) ;
  1.  N X,X2,X3
  1.  Q:(IBILL="")!(IBILL=0) ""
  1.  S X=$P($G(^IB(IBILL,0)),U,7),X2="2$",X3=0 D COMMA^%DTC
  1.  Q X
  1.  ;
  1.  ;Collect the RX related data using Pharmacy API for the report and store in ^TMP($J,"IBRXARR"
  1.  ;DFN = Patient IEN
  1.  ;IBBDT = Beginning search date, used to determine if Rx was filled within this date
  1. COLLECT(DFN,IBBDT) ; Collect data for patient
  1.  N LIST,IBRX,IBFIL,CNT
  1.  S LIST="IBRXARR",(IBRX,CNT,IBFIL)=0
  1.  K ^TMP($J,LIST)
  1.  D RX^PSO52API(DFN,LIST,,,"2,I,R",,)
  1.  F  S IBRX=$O(^TMP($J,LIST,DFN,IBRX)) Q:'IBRX  D
  1.  . Q:'+$P(^TMP($J,LIST,DFN,IBRX,31),U)
  1.  . D GETDATA(0,IBRX,DFN,LIST)
  1.  . I ^TMP($J,LIST,DFN,IBRX,"RF",0)<0 Q
  1.  . F  S IBFIL=$O(^TMP($J,LIST,DFN,IBRX,"RF",IBFIL)) Q:IBFIL=""  D 
  1.  . . Q:IBFIL=0
  1.  . . D GETDATA(IBFIL,IBRX,DFN,LIST)
  1.  . Q
  1.  Q
  1.  ;
  1.  ;Gets specific data for first and third party bills and store in TMP file
  1.  ;IBFIL = RX Fill #
  1.  ;IBRX = IEN to Prescription file - RX ID Placeholder in the TMP file
  1.  ;DFN = Patient IEN
  1.  ;LIST = placeholder for data in ^TMP file
  1. GETDATA(IBFIL,IBRX,DFN,LIST) ;
  1.  N IBBA,IBBILL,IBRXN,IBFILDT,IBRXINS,IBBILLN,IBECN
  1.  I IBFIL=0 D
  1.  . S IBFILDT=+$P(^TMP($J,LIST,DFN,IBRX,22),U)
  1.  . S IBBA=+$P($G(^TMP($J,LIST,DFN,IBRX,106)),U)
  1.  E  S IBFILDT=+$P(^TMP($J,LIST,DFN,IBRX,"RF",IBFIL,.01),U) D
  1.  . S IBBA=+$P($G(^TMP($J,LIST,DFN,IBRX,"IB",IBFIL,9)),U)
  1.  Q:IBFILDT<IBBDT
  1.  S IBRXN=^TMP($J,LIST,DFN,IBRX,.01)
  1.  ; First party copay
  1.  I $$BILLCNCL(IBBA) Q
  1.  S IBBILL=$P($P($G(^IB(IBBA,0)),U,11),"-",2)
  1.  I IBBILL="" S IBBILL=$$BILLSTS(IBBA)
  1.  S CNT=CNT+1 D SETREF(CNT,IBRXN,IBFIL,IBFILDT,IBBILL,"Copay","",$$BILLAMNT(IBBA))
  1.  ; Third party bills
  1.  S IBBILL=$$BILL(IBRXN,IBFILDT) Q:IBBILL']""
  1.  S IBBILLN=$$GETBILLN(IBBILL)
  1.  S IBRXINS=$$GETINS(IBBILL)
  1.  S IBECN=$$GETECME(IBBILL)
  1.  S CNT=CNT+1 D SETREF(CNT,IBRXN,IBFIL,IBFILDT,IBBILLN,IBRXINS,IBECN,"")
  1.  Q
  1.  ;
  1.  ;SETREF sets the reference global with report data
  1.  ;INPUT: DATA = Counter^RxIEN^Rx#^Fill#^FillDate^BillNumber^BillInsurance^ECME#^TotalCharge
  1. SETREF(CNT,IBRXN,IBFIL,IBDT,IBBILLN,IBRXINS,IBECN,IBCHRG) ;
  1.  S @REF@(DFN,CNT)=IBRXN_U_IBFIL_U_IBDT_U_IBBILLN_U_IBECN_U_IBRXINS_U_IBCHRG
  1.  Q
  1.  ;
  1.  ;Get the Bill Number from file 399
  1.  ;Input:
  1.  ;IEN of file 399
  1.  ;Returns:
  1.  ;BILL NUMBER field
  1. GETBILLN(IBBIL) ;
  1.  Q $P($G(^DGCR(399,IBBIL,0)),U)_$$ECME^IBTRE(IBBIL,"")
  1.  ;
  1.  ;Get the ECME Number from file 399
  1.  ;Input:
  1.  ;IEN of file 399
  1.  ;Returns:
  1.  ;ECME NUMBER field
  1. GETECME(IBBIL) ;
  1.  Q $P($P($G(^DGCR(399,IBBIL,"M1")),U,8),";")
  1.  ;
  1.  ;Get Insurance payer
  1.  ;Input:
  1.  ;IEN of file 399
  1.  ;Returns:
  1.  ;Insurance company name prefixed with p-, s-, or t-.
  1. GETINS(IBBIL) ;
  1.  N IBINS,IBSEQ,IBM
  1.  Q:'$D(^DGCR(399,IBBIL,0)) ""
  1.  S IBSEQ=$P($G(^DGCR(399,IBBIL,0)),U,21)
  1.  ;Don't include Patient in CURRENT BILL PAYER SEQUENCE.
  1.  Q:IBSEQ["A" ""
  1.  S IBM=$G(^DGCR(399,IBBIL,"M"))
  1.  Q:'IBM "UNKNOWN"
  1.  S IBINS=$S(IBSEQ="P":$P(IBM,U),IBSEQ="S":$P(IBM,U,2),IBSEQ="T":$P(IBM,U,3))
  1.  I IBINS']"" Q "UNKNOWN"
  1.  Q $$LOW^XLFSTR(IBSEQ)_"-"_$P($G(^DIC(36,IBINS,0)),U)
  1.  ;