| 1 | IBRBUL ;ALB/CJM-MEANS TEST HOLD CHARGE BULLETIN ;02-MAR-92
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**70,95,121,153,195,347**;21-MAR-94;Build 24
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ; This bulletin is sent even if the local site has chosen not to hold
|
|---|
| 5 | ; Means Test charges. In that case, IBHOLDP should be set = 0.
|
|---|
| 6 | ; requires: IBDD() = internal node in patient file of valid ins.
|
|---|
| 7 | ; DUZ
|
|---|
| 8 | ; X = 0 node of IB BILLING ACTION
|
|---|
| 9 | ; IBHOLDP = 1 if charge on hold, = 0 otherwise
|
|---|
| 10 | ; IBSEQNO = 1 if the charges are new, 3 if updated
|
|---|
| 11 | BULL N XMSUB,XMY,XMDUZ,XMTEXT,IBX,IBDUZ,IBNAME,IBPID,IBBID,IBAGE,DFN
|
|---|
| 12 | S IBX=X,IBDUZ=DUZ
|
|---|
| 13 | K ^TMP($J,"IBRBUL")
|
|---|
| 14 | D PAT,HDR,PATLINE,CHRG,INS,BUF,MAIL
|
|---|
| 15 | K ^TMP($J,"IBRBUL")
|
|---|
| 16 | Q
|
|---|
| 17 | MAIL ; Transmit mail
|
|---|
| 18 | N IBGRP S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="^TMP($J,""IBRBUL"","
|
|---|
| 19 | K XMY
|
|---|
| 20 | S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),U,11),0)),U)
|
|---|
| 21 | I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
|
|---|
| 22 | D ^XMD
|
|---|
| 23 | Q
|
|---|
| 24 | ;Add a line to the text array
|
|---|
| 25 | ADDLN(IBTXT) N IBC
|
|---|
| 26 | S IBC=$O(^TMP($J,"IBRBUL",""),-1)+1
|
|---|
| 27 | S ^TMP($J,"IBRBUL",IBC)=$G(IBTXT," ")
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | MAILTST ; for testing
|
|---|
| 31 | ;N IBC
|
|---|
| 32 | ;W !,XMSUB
|
|---|
| 33 | ;F IBC=1:1 Q:'$D(^TMP($J,"IBRBUL",IBC)) W !,^(IBC)
|
|---|
| 34 | Q
|
|---|
| 35 | HDR ; formated for held charges
|
|---|
| 36 | N IBW,IBU,IBV,SL S IBW=$S('IBHOLDP:"NOT ON HOLD",1:"ON HOLD"),IBU=$S(IBSEQNO=1:"NEW ",IBSEQNO=3:"UPDATED ",1:""),IBV=$S(+$O(IBDD(0)):"active",1:"may have")
|
|---|
| 37 | ; if the parent event should have the soft-link that is needed to find
|
|---|
| 38 | ; the division
|
|---|
| 39 | S SL=$P(X,"^",16) S:SL SL=$G(^IB(SL,0)) S:'SL SL=X S SL=$P(SL,"^",4)
|
|---|
| 40 | S XMSUB=$E(IBNAME,1,8)_"("_IBBID_")"_" PATIENT CHRG W/INS"_"-"_$E($$DIV(SL),1,11)
|
|---|
| 41 | D ADDLN("The following patient has "_IBU_"charges "_IBW_" and "_IBV_" insurance.")
|
|---|
| 42 | D ADDLN("You need to immediately process the charges to the insurance company.")
|
|---|
| 43 | I +$$BUFFER^IBCNBU1(+$P(X,"^",2)) D
|
|---|
| 44 | . D ADDLN()
|
|---|
| 45 | . D ADDLN("This patient has entries in the Insurance Buffer that should be processed")
|
|---|
| 46 | . D ADDLN("before the charges.")
|
|---|
| 47 | Q
|
|---|
| 48 | PAT ; gets patient demographic data
|
|---|
| 49 | N VAERR,VADM,X,VA
|
|---|
| 50 | S DFN=+$P(IBX,"^",2) D DEM^VADPT I VAERR K VADM
|
|---|
| 51 | S IBNAME=$$PR($G(VADM(1)),26),IBAGE=$$PR($G(VADM(4)),3),IBPID=$G(VA("PID")),IBBID=$G(VA("BID"))
|
|---|
| 52 | Q
|
|---|
| 53 | PATLINE ; sets up lines with patient data
|
|---|
| 54 | D ADDLN(),ADDLN("Name: "_IBNAME_" Age : "_IBAGE_" Pt. ID: "_IBPID)
|
|---|
| 55 | Q
|
|---|
| 56 | CHRG ; gets charge data and sets up charge lines
|
|---|
| 57 | N TP,FR,TO,IBND1,IBRXN,IBRX,IBRDT,IBRF,IENS
|
|---|
| 58 | S IBND1=$G(^IB(+$G(IBN),1)),(IBRX,IBRXN,IBRF,IBRDT)=0
|
|---|
| 59 | S FR=$$DAT1^IBOUTL($S($P(IBX,"^",14)'="":($P(IBX,"^",14)),1:$P(IBND1,"^",2)))
|
|---|
| 60 | S TO=$$DAT1^IBOUTL($S($P(IBX,"^",15)'="":($P(IBX,"^",15)),1:$P(IBND1,"^",2)))
|
|---|
| 61 | I $P(IBX,"^",4)["52:" S IBRXN=$P($P(IBX,"^",4),":",2),IBRX=$P($P(IBX,"^",8),"-"),IBRF=$P($P(IBX,"^",4),":",3)
|
|---|
| 62 | I $P(IBX,"^",4)["52:" D
|
|---|
| 63 | .I IBRF>0 S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IENS,52,.01)
|
|---|
| 64 | .E S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(IENS,22)
|
|---|
| 65 | S TP=$P(IBX,"^",3) S:TP TP=$P($G(^IBE(350.1,TP,0)),"^",3) S:TP TP=$P($$CATN^PRCAFN(TP),"^",2)
|
|---|
| 66 | D ADDLN("Type: "_$$PR(TP,28)_" Amount : $"_+$P(IBX,"^",7))
|
|---|
| 67 | D ADDLN("From: "_$$PR(FR,28)_" To : "_TO)
|
|---|
| 68 | I IBRXN D ADDLN("Rx #: "_$$PR(IBRX_$S(IBRF'="":" ("_IBRF_")",1:""),28)_" Fill Dt: "_$$DAT1^IBOUTL(IBRDT)_" Rls Dt: "_TO)
|
|---|
| 69 | Q
|
|---|
| 70 | INS ; gets insurance data and sets up insurance lines
|
|---|
| 71 | N I,CO,P,G,GNB,W,E,Y,C,COV,COVD,COVFN,LEDT,LIM,PLN,X1,X2,Z0,IBCNT,P1,P2,P3,P4
|
|---|
| 72 | ;S IBDTIN=$P(IBX,"^",14)
|
|---|
| 73 | D ADDLN(),ADDLN("INSURANCE INFORMATION:")
|
|---|
| 74 | S I="" F S I=$O(IBDD(I)) Q:'I D
|
|---|
| 75 | .S LIM=0
|
|---|
| 76 | .S CO=$P(IBDD(I),"^",1),CO=$P(^DIC(36,CO,0),"^",1),CO=$$PR(CO,25)
|
|---|
| 77 | .S P=$$PR($P(IBDD(I),"^",2),21)
|
|---|
| 78 | .S P1=2.312,P2=6,P3=$P($G(IBDD(I)),"^",6) S P4=$$EXPAND^IBTRE(P1,P2,P3) S W=$$PR(P4,25)
|
|---|
| 79 | .S Y=$P(IBDD(I),"^",4) D:Y DD^%DT S E=Y
|
|---|
| 80 | .S G=$$PR($P(IBDD(I),"^",15),25)
|
|---|
| 81 | .S GNB=$P(IBDD(I),"^",3)
|
|---|
| 82 | .S PLN=$P(IBDD(I),"^",18)
|
|---|
| 83 | .D ADDLN(),ADDLN("Company: "_CO_" Policy#: "_P)
|
|---|
| 84 | .D ADDLN("Whose : "_W_" Expires: "_E)
|
|---|
| 85 | .D ADDLN("Group : "_G_" Group# : "_GNB)
|
|---|
| 86 | .Q:'PLN
|
|---|
| 87 | .D ADDLN(" Plan Coverage Effective Date Covered? Limit Comments")
|
|---|
| 88 | .D ADDLN(" ------------- -------------- -------- --------------")
|
|---|
| 89 | .F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM S COV=$P($G(^(LIM,0)),U),IBCNT=0,LEDT="" F S LEDT=$O(^IBA(355.32,"APCD",PLN,LIM,LEDT)) Q:$S(LEDT="":IBCNT,1:0) D Q:LEDT=""
|
|---|
| 90 | ..S COVFN=+$O(^IBA(355.32,"APCD",PLN,LIM,+LEDT,"")),COVD=$G(^IBA(355.32,+COVFN,0))
|
|---|
| 91 | ..I COVD="" D ADDLN(" "_$$PR(COV,32)_"BY DEFAULT") Q
|
|---|
| 92 | ..S IBCNT=IBCNT+1
|
|---|
| 93 | ..S X1=" "_$S(IBCNT=1:COV,1:"") ;Don't duplicate category
|
|---|
| 94 | ..S X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($P(LEDT,"-",2)),16)_$$PR($S($P(COVD,U,4):$S($P(COVD,U,4)<2:"YES",$P(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
|
|---|
| 95 | ..I '$O(^IBA(355.32,COVFN,2,0)) D ADDLN(X2) Q
|
|---|
| 96 | ..S Z0=0 F S Z0=$O(^IBA(355.32,COVFN,2,Z0)) Q:'Z0 D ADDLN($S(Z0=1:X2_$G(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR("",48)_$G(^IBA(355.32,COVFN,2,Z0,0))))
|
|---|
| 97 | Q
|
|---|
| 98 | PR(STR,LEN) ; pad right
|
|---|
| 99 | N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
|
|---|
| 100 | Q STR_$G(B)
|
|---|
| 101 | DIV(SL) ; returns the division with the softlink as input
|
|---|
| 102 | N IBDIV,IBWARD,IBFILE,IBIEN
|
|---|
| 103 | S:SL[";" SL=$P(SL,";",1)
|
|---|
| 104 | S IBFILE=$P(SL,":",1),IBIEN=$P(SL,":",2)
|
|---|
| 105 | S IBDIV=""
|
|---|
| 106 | I IBFILE=409.68,IBIEN S IBDIV=$$SCE^IBSDU(IBIEN,11)
|
|---|
| 107 | I IBFILE=44,IBIEN S IBDIV=$P($G(^SC(IBIEN,0)),"^",15)
|
|---|
| 108 | I IBFILE=405,IBIEN S IBWARD=$P($G(^DGPM(IBIEN,0)),"^",6) I IBWARD S IBDIV=$P($G(^DIC(42,IBWARD,0)),"^",11)
|
|---|
| 109 | I IBDIV S IBDIV=$P($G(^DG(40.8,IBDIV,0)),"^",1)
|
|---|
| 110 | I IBDIV="" S IBDIV="DIV UNKNWN"
|
|---|
| 111 | Q IBDIV
|
|---|
| 112 | ;
|
|---|
| 113 | BUF ; gets insurance buffer entries and sets up lines to add to bulletin
|
|---|
| 114 | N DFN,IBBDA,IBB40,IBB60,IBX1,IBX2 S DFN=$P(IBX,U,2) Q:'DFN
|
|---|
| 115 | I '$$BUFFER^IBCNBU1(DFN) Q
|
|---|
| 116 | ;
|
|---|
| 117 | D ADDLN()
|
|---|
| 118 | D ADDLN("INSURANCE BUFFER:")
|
|---|
| 119 | S IBBDA=0 F S IBBDA=$O(^IBA(355.33,"C",DFN,IBBDA)) Q:'IBBDA D
|
|---|
| 120 | . S IBB40=$G(^IBA(355.33,IBBDA,40)),IBB60=$G(^IBA(355.33,IBBDA,60))
|
|---|
| 121 | . ;
|
|---|
| 122 | . D ADDLN()
|
|---|
| 123 | . S IBX1=$P($G(^IBA(355.33,IBBDA,20)),U,1),IBX2=$P(IBB60,U,4)
|
|---|
| 124 | . D ADDLN("Company: "_$$PR(IBX1,25)_"Policy#: "_$$PR(IBX2,21))
|
|---|
| 125 | . S IBX1=$$EXPAND^IBTRE(355.33,60.05,$P(IBB60,U,5)),IBX2=$$FMTE^XLFDT($P(IBB60,U,3))
|
|---|
| 126 | . D ADDLN("Whose : "_$$PR(IBX1,25)_"Expires: "_IBX2)
|
|---|
| 127 | . S IBX1=$P(IBB40,U,2),IBX2=$P(IBB40,U,3)
|
|---|
| 128 | . D ADDLN("Group : "_$$PR(IBX1,25)_"Group# : "_IBX2)
|
|---|
| 129 | Q
|
|---|
