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

IB20P247.m

Go to the documentation of this file.
  1. IB20P247 ;WOIFO/SS - POST INIT ROUTINE FOR IB*2*247 ;6-OCT-03
  1. ;;2.0;INTEGRATED BILLING;**247**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. Q
  1. POST ; adding charge removal reason entries if not there
  1. N IBX,IBT,IBY,X,Y,DIC,DO
  1. D ADDCRR
  1. D ADDNBR
  1. Q
  1. ;
  1. ADDCRR ; need to add charge removal reasons
  1. N IBX,IBT,IBY,DIC,Y,X
  1. F IBX=1:1 S IBY=$P($T(CRR+IBX),";",3,99) Q:IBY="" S IBT=$P(IBY,";") I '$O(^IBE(350.3,"B",IBT,0)) K DO D
  1. . S DIC="^IBE(350.3,",DIC(0)="",X=IBT,DIC("DR")=$P(IBY,";",2,3)
  1. . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Charge Removal Reasons: "_IBT)
  1. Q
  1. ;
  1. ADDNBR ; need to add non billable reasons
  1. F IBX=1:1 S IBT=$P($T(NBR+IBX),";",3) Q:IBT="" I '$O(^IBE(356.8,"B",IBT,0)) K DO D
  1. . S DIC="^IBE(356.8,",DIC(0)="",X=IBT
  1. . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Reason Not Billable: "_IBT)
  1. Q
  1. ;
  1. CRR ; charge removal reasons to add in #350.3
  1. ;;COMBAT VETERAN;.02///CV;.03///GENERIC
  1. ;;
  1. NBR ; non-billable reasons to add in #356.8 if not there
  1. ;;HEAD/NECK CANCER
  1. ;;COMBAT VETERAN
  1. ;;
  1. ;
  1. ;-------- report for CV expiration date problem
  1. RPT ;
  1. I '$$PATCH^XPDUTL("DG*5.3*576") W !,"The patch DG*5.3*576 needs to be installed to run the report." Q
  1. K ^TMP("DGCVEX",$J),^TMP("IBCVEX",$J)
  1. D EN^DGCVEXP
  1. N IBDFN,IBDT,IBNNN
  1. S IBNNN=0
  1. S IBDFN=0 F S IBDFN=$O(^TMP("DGCVEX",$J,IBDFN)) Q:+IBDFN=0 D
  1. . S IBDT=0 F S IBDT=$O(^TMP("DGCVEX",$J,IBDFN,IBDT)) Q:+IBDT=0 D COUNTIN(IBDFN,IBDT,.IBNNN)
  1. D PRINTREP(IBNNN)
  1. K ^TMP("DGCVEX",$J),^TMP("IBCVEX",$J)
  1. Q
  1. ;--------
  1. ;IBDF - patient's DFN
  1. ;IBD - the last date of CV
  1. COUNTIN(IBDF,IBD,IBNN) ;
  1. ;3rd party claims
  1. N IBIEN,IBRVDT,IB1,IBTO,IBFR,IBI,IBK
  1. S IBIEN=0 F S IBIEN=$O(^DGCR(399,"C",IBDF,IBIEN)) Q:+IBIEN=0 D
  1. . S IB1=$G(^DGCR(399,IBIEN,0))
  1. . Q:+$P(IB1,"^",5)=0 ;no care type
  1. . S IBTO=+$P($G(^DGCR(399,IBIEN,"U")),"^",2),IBFR=+$G(^DGCR(399,IBIEN,"U"))
  1. . ;outpatients
  1. . I $P(IB1,"^",5)>2 D:IBD=IBFR SETTMP(IBDF,IBD,IBIEN,1,.IBNN) Q
  1. . ;inpatients
  1. . I (IBD'<IBFR) I IBTO=0!(IBD'>IBTO) D SETTMP(IBDF,IBD,IBIEN,2,.IBNN)
  1. ;1st party copays
  1. S IBIEN=0 F S IBIEN=$O(^IB("C",IBDF,IBIEN)) Q:+IBIEN=0 D
  1. . S IB1=$G(^IB(IBIEN,0)),IBFR=+$P(IB1,"^",14),IBTO=+$P(IB1,"^",15)
  1. . I (IBD'<IBFR),(IBD'>IBTO) D SETTMP(IBDF,IBD,IBIEN,3,.IBNN)
  1. Q
  1. ;--------
  1. ; print report
  1. PRINTREP(IBNN) ;
  1. N IBDFN,IBDT,IB1,IBN
  1. D HEADER
  1. S IBDFN=0 F S IBDFN=$O(^TMP("IBCVEX",$J,IBDFN)) Q:+IBDFN=0 D
  1. . S IBDT=0 F S IBDT=$O(^TMP("IBCVEX",$J,IBDFN,IBDT)) Q:+IBDT=0 D
  1. .. S IBN=0 F S IBN=$O(^TMP("IBCVEX",$J,IBDFN,IBDT,IBN)) Q:+IBN=0 D OUTP(IBDFN,IBDT,$G(^TMP("IBCVEX",$J,IBDFN,IBDT,IBN)))
  1. D FOOTER(IBNN)
  1. Q
  1. ;--------
  1. ;set ^TMP
  1. SETTMP(IBDFN,IBDT,IBIEN1,IBTYP,IBNUM) ;
  1. S IBNUM=IBNUM+1,^TMP("IBCVEX",$J,IBDFN,IBDT,IBNUM)=IBTYP_"^"_IBIEN1
  1. Q
  1. OUTP(IBDFN,IBDT,IBDATA) ;
  1. Q:$G(IBDATA)=""
  1. N Y S Y=$$PATINFO(IBDFN)
  1. W !,$P(Y,"^"),?30,$P(Y,"^",2),?43,$$STRDATE(IBDT),?55,$E($$BILLINFO(IBDATA),1,18)
  1. Q
  1. ;--------
  1. ;billing info
  1. BILLINFO(IBDATA) ;
  1. I +IBDATA=3 Q $P($P($G(^IB(+$P(IBDATA,"^",2),0)),"^",11),"-",2)_" PATIENT"
  1. Q $P($G(^DGCR(399,+$P(IBDATA,"^",2),0)),"^")_" INSURANCE"
  1. ;--------
  1. ;Fileman date to String format
  1. ;Y - fileman date
  1. STRDATE(Y) ;
  1. I Y>0 X ^DD("DD") Q Y
  1. Q ""
  1. ;--------
  1. ;patient info
  1. PATINFO(DFN) ;
  1. I +$G(DFN)=0 Q "??"
  1. N VADM,VA,VAERR
  1. D DEM^VADPT
  1. Q $E($G(VADM(1)),1,28)_"^"_$P($G(VADM(2)),"^",2)
  1. ;
  1. ;--------
  1. W !,"...Please wait..."
  1. W !,?15,">> CV Billing Verification Report <<"
  1. D LINE
  1. W !,"Name",?30,"SSN",?43,"Date",?55,"Bill #"
  1. D LINE
  1. Q
  1. ;--------
  1. D LINE
  1. W !,"Total: "_IBNNN_" bills/copays"
  1. Q
  1. ;--------
  1. LINE ;line
  1. W !,"-----------------------------",?30,"------------",?43,"-----------",?55,"------------------"
  1. Q
  1. ;