[613] | 1 | IB20P247 ;WOIFO/SS - POST INIT ROUTINE FOR IB*2*247 ;6-OCT-03
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**247**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | Q
|
---|
| 6 | POST ; adding charge removal reason entries if not there
|
---|
| 7 | N IBX,IBT,IBY,X,Y,DIC,DO
|
---|
| 8 | D ADDCRR
|
---|
| 9 | D ADDNBR
|
---|
| 10 | Q
|
---|
| 11 | ;
|
---|
| 12 | ADDCRR ; need to add charge removal reasons
|
---|
| 13 | N IBX,IBT,IBY,DIC,Y,X
|
---|
| 14 | 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
|
---|
| 15 | . S DIC="^IBE(350.3,",DIC(0)="",X=IBT,DIC("DR")=$P(IBY,";",2,3)
|
---|
| 16 | . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Charge Removal Reasons: "_IBT)
|
---|
| 17 | Q
|
---|
| 18 | ;
|
---|
| 19 | ADDNBR ; need to add non billable reasons
|
---|
| 20 | F IBX=1:1 S IBT=$P($T(NBR+IBX),";",3) Q:IBT="" I '$O(^IBE(356.8,"B",IBT,0)) K DO D
|
---|
| 21 | . S DIC="^IBE(356.8,",DIC(0)="",X=IBT
|
---|
| 22 | . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Reason Not Billable: "_IBT)
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | CRR ; charge removal reasons to add in #350.3
|
---|
| 26 | ;;COMBAT VETERAN;.02///CV;.03///GENERIC
|
---|
| 27 | ;;
|
---|
| 28 | NBR ; non-billable reasons to add in #356.8 if not there
|
---|
| 29 | ;;HEAD/NECK CANCER
|
---|
| 30 | ;;COMBAT VETERAN
|
---|
| 31 | ;;
|
---|
| 32 | ;
|
---|
| 33 | ;-------- report for CV expiration date problem
|
---|
| 34 | RPT ;
|
---|
| 35 | I '$$PATCH^XPDUTL("DG*5.3*576") W !,"The patch DG*5.3*576 needs to be installed to run the report." Q
|
---|
| 36 | K ^TMP("DGCVEX",$J),^TMP("IBCVEX",$J)
|
---|
| 37 | D EN^DGCVEXP
|
---|
| 38 | N IBDFN,IBDT,IBNNN
|
---|
| 39 | S IBNNN=0
|
---|
| 40 | S IBDFN=0 F S IBDFN=$O(^TMP("DGCVEX",$J,IBDFN)) Q:+IBDFN=0 D
|
---|
| 41 | . S IBDT=0 F S IBDT=$O(^TMP("DGCVEX",$J,IBDFN,IBDT)) Q:+IBDT=0 D COUNTIN(IBDFN,IBDT,.IBNNN)
|
---|
| 42 | D PRINTREP(IBNNN)
|
---|
| 43 | K ^TMP("DGCVEX",$J),^TMP("IBCVEX",$J)
|
---|
| 44 | Q
|
---|
| 45 | ;--------
|
---|
| 46 | ;IBDF - patient's DFN
|
---|
| 47 | ;IBD - the last date of CV
|
---|
| 48 | COUNTIN(IBDF,IBD,IBNN) ;
|
---|
| 49 | ;3rd party claims
|
---|
| 50 | N IBIEN,IBRVDT,IB1,IBTO,IBFR,IBI,IBK
|
---|
| 51 | S IBIEN=0 F S IBIEN=$O(^DGCR(399,"C",IBDF,IBIEN)) Q:+IBIEN=0 D
|
---|
| 52 | . S IB1=$G(^DGCR(399,IBIEN,0))
|
---|
| 53 | . Q:+$P(IB1,"^",5)=0 ;no care type
|
---|
| 54 | . S IBTO=+$P($G(^DGCR(399,IBIEN,"U")),"^",2),IBFR=+$G(^DGCR(399,IBIEN,"U"))
|
---|
| 55 | . ;outpatients
|
---|
| 56 | . I $P(IB1,"^",5)>2 D:IBD=IBFR SETTMP(IBDF,IBD,IBIEN,1,.IBNN) Q
|
---|
| 57 | . ;inpatients
|
---|
| 58 | . I (IBD'<IBFR) I IBTO=0!(IBD'>IBTO) D SETTMP(IBDF,IBD,IBIEN,2,.IBNN)
|
---|
| 59 | ;1st party copays
|
---|
| 60 | S IBIEN=0 F S IBIEN=$O(^IB("C",IBDF,IBIEN)) Q:+IBIEN=0 D
|
---|
| 61 | . S IB1=$G(^IB(IBIEN,0)),IBFR=+$P(IB1,"^",14),IBTO=+$P(IB1,"^",15)
|
---|
| 62 | . I (IBD'<IBFR),(IBD'>IBTO) D SETTMP(IBDF,IBD,IBIEN,3,.IBNN)
|
---|
| 63 | Q
|
---|
| 64 | ;--------
|
---|
| 65 | ; print report
|
---|
| 66 | PRINTREP(IBNN) ;
|
---|
| 67 | N IBDFN,IBDT,IB1,IBN
|
---|
| 68 | D HEADER
|
---|
| 69 | S IBDFN=0 F S IBDFN=$O(^TMP("IBCVEX",$J,IBDFN)) Q:+IBDFN=0 D
|
---|
| 70 | . S IBDT=0 F S IBDT=$O(^TMP("IBCVEX",$J,IBDFN,IBDT)) Q:+IBDT=0 D
|
---|
| 71 | .. 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)))
|
---|
| 72 | D FOOTER(IBNN)
|
---|
| 73 | Q
|
---|
| 74 | ;--------
|
---|
| 75 | ;set ^TMP
|
---|
| 76 | SETTMP(IBDFN,IBDT,IBIEN1,IBTYP,IBNUM) ;
|
---|
| 77 | S IBNUM=IBNUM+1,^TMP("IBCVEX",$J,IBDFN,IBDT,IBNUM)=IBTYP_"^"_IBIEN1
|
---|
| 78 | Q
|
---|
| 79 | OUTP(IBDFN,IBDT,IBDATA) ;
|
---|
| 80 | Q:$G(IBDATA)=""
|
---|
| 81 | N Y S Y=$$PATINFO(IBDFN)
|
---|
| 82 | W !,$P(Y,"^"),?30,$P(Y,"^",2),?43,$$STRDATE(IBDT),?55,$E($$BILLINFO(IBDATA),1,18)
|
---|
| 83 | Q
|
---|
| 84 | ;--------
|
---|
| 85 | ;billing info
|
---|
| 86 | BILLINFO(IBDATA) ;
|
---|
| 87 | I +IBDATA=3 Q $P($P($G(^IB(+$P(IBDATA,"^",2),0)),"^",11),"-",2)_" PATIENT"
|
---|
| 88 | Q $P($G(^DGCR(399,+$P(IBDATA,"^",2),0)),"^")_" INSURANCE"
|
---|
| 89 | ;--------
|
---|
| 90 | ;Fileman date to String format
|
---|
| 91 | ;Y - fileman date
|
---|
| 92 | STRDATE(Y) ;
|
---|
| 93 | I Y>0 X ^DD("DD") Q Y
|
---|
| 94 | Q ""
|
---|
| 95 | ;--------
|
---|
| 96 | ;patient info
|
---|
| 97 | PATINFO(DFN) ;
|
---|
| 98 | I +$G(DFN)=0 Q "??"
|
---|
| 99 | N VADM,VA,VAERR
|
---|
| 100 | D DEM^VADPT
|
---|
| 101 | Q $E($G(VADM(1)),1,28)_"^"_$P($G(VADM(2)),"^",2)
|
---|
| 102 | ;
|
---|
| 103 | ;--------
|
---|
| 104 | HEADER ;header
|
---|
| 105 | W !,"...Please wait..."
|
---|
| 106 | W !,?15,">> CV Billing Verification Report <<"
|
---|
| 107 | D LINE
|
---|
| 108 | W !,"Name",?30,"SSN",?43,"Date",?55,"Bill #"
|
---|
| 109 | D LINE
|
---|
| 110 | Q
|
---|
| 111 | ;--------
|
---|
| 112 | FOOTER(IBNNN) ;footer
|
---|
| 113 | D LINE
|
---|
| 114 | W !,"Total: "_IBNNN_" bills/copays"
|
---|
| 115 | Q
|
---|
| 116 | ;--------
|
---|
| 117 | LINE ;line
|
---|
| 118 | W !,"-----------------------------",?30,"------------",?43,"-----------",?55,"------------------"
|
---|
| 119 | Q
|
---|
| 120 | ;
|
---|