| 1 | IBAMTC3 ;ALB/CJM - BULLETINS FOR UNCLOSED EVENTS,UNPASSED CHARGES ; 21-APRIL-92
 | 
|---|
| 2 |  ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 | BULLET1 N IBT,IBC,XMSUB,XMY,XMDUZ,XMTEXT
 | 
|---|
| 5 |  S IBC=1,IBDUZ=$G(DUZ)
 | 
|---|
| 6 |  D HDR1,PAT1,CHRG1,MAIL^IBAERR1
 | 
|---|
| 7 |  Q
 | 
|---|
| 8 | BULLET2 N IBT,IBC,XMSUB,XMY,XMDUZ,XMTEXT
 | 
|---|
| 9 |  S IBC=1,IBDUZ=$G(DUZ)
 | 
|---|
| 10 |  D HDR2,PAT2,CHRG2,MAIL^IBAERR1
 | 
|---|
| 11 |  Q
 | 
|---|
| 12 | MAIL ; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CALL MAIL^IBAERR1
 | 
|---|
| 13 |  ; F I=1:1:(IBC-1) W IBT(I),!
 | 
|---|
| 14 |  ; Q
 | 
|---|
| 15 | HDR1 ;
 | 
|---|
| 16 |  S XMSUB="REQUIRED VERIFICATION OF MEANS TEST CHARGES"
 | 
|---|
| 17 |  S IBT(IBC)="Please verify the Means Test charges for the following inpatient admission:",IBC=IBC+1
 | 
|---|
| 18 |  Q
 | 
|---|
| 19 | HDR2 ;
 | 
|---|
| 20 |  S XMSUB="MEANS TEST CHARGES NOT YET PASSED TO ACCOUNTS RECEIVABLE"
 | 
|---|
| 21 |  S IBT(IBC)="The following charge is "_IBOLD_" days old and has not been passed to Accounts ",IBT(IBC+1)="Receivable. Action is required to edit, cancel, or pass the charge.",IBC=IBC+2
 | 
|---|
| 22 |  Q
 | 
|---|
| 23 | CHRG2 ;
 | 
|---|
| 24 |  N I,IBTYPE,IBFROM,IBTO,IBAMOUNT
 | 
|---|
| 25 |  D CHGDATA
 | 
|---|
| 26 |  S IBT(IBC)="Type        :       "_IBTYPE,IBC=IBC+1
 | 
|---|
| 27 |  S IBT(IBC)="From        :       "_IBFROM,IBC=IBC+1
 | 
|---|
| 28 |  S IBT(IBC)="To          :       "_IBTO,IBC=IBC+1
 | 
|---|
| 29 |  S IBT(IBC)="Amount      :       "_IBAMOUNT,IBC=IBC+1
 | 
|---|
| 30 |  Q
 | 
|---|
| 31 | CHRG1 ;
 | 
|---|
| 32 |  N I,IBTYPE,IBFROM,IBTO,IBAMOUNT
 | 
|---|
| 33 |  I 'IBPASS&(IBCHG) D
 | 
|---|
| 34 |  .S IBT(IBC)=" ",IBT(IBC+1)="These charges have not been passed to Accounts Receivable.",IBT(IBC+2)="Action is required to edit, cancel, or pass the charges.",IBT(IBC+3)=" ",IBC=IBC+4
 | 
|---|
| 35 |  .S IBT(IBC)=$$PR("Type",30)_$$PR("From",16)_$$PR("To",16)_$$PR("Amount",15),IBC=IBC+1
 | 
|---|
| 36 |  .F I=1:1:IBCHG S IBND=$G(^IB(IBCHG(I),0)) D CHGDATA D
 | 
|---|
| 37 |  ..S IBT(IBC)=$$PR(IBTYPE,30)_$$PR(IBFROM,16)_$$PR(IBTO,16)_$$PR(IBAMOUNT,15),IBC=IBC+1
 | 
|---|
| 38 |  Q
 | 
|---|
| 39 | CHGDATA ;
 | 
|---|
| 40 |  S Y=$P(IBND,"^",14) D:Y DD^%DT S IBFROM=Y
 | 
|---|
| 41 |  S Y=$P(IBND,"^",15) D:Y DD^%DT S IBTO=Y
 | 
|---|
| 42 |  S IBTYPE=$P(IBND,"^",3) S:IBTYPE IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1)
 | 
|---|
| 43 |  S IBAMOUNT="$"_+$P(IBND,"^",7)
 | 
|---|
| 44 |  Q
 | 
|---|
| 45 | PAT1 ; patient demographic data, admission and discharge date
 | 
|---|
| 46 |  N VAERR,VADM,DFN,IBNAME,IBID,IBADMIT,VA
 | 
|---|
| 47 |  S IBT(IBC)=" ",IBC=IBC+1
 | 
|---|
| 48 |  S DFN=+$P(IBND,"^",2) D DEM^VADPT I VAERR K VADM
 | 
|---|
| 49 |  S IBNAME=$G(VADM(1)),IBID=$G(VA("PID"))
 | 
|---|
| 50 |  S Y=$P(IBND,"^",17) D DD^%DT S IBADMIT=Y
 | 
|---|
| 51 |  S Y=IBDISC D DD^%DT S IBDISC=Y
 | 
|---|
| 52 |  S IBT(IBC)="Patient Name:       "_IBNAME,IBC=IBC+1
 | 
|---|
| 53 |  S IBT(IBC)="Patient Id  :       "_IBID,IBC=IBC+1
 | 
|---|
| 54 |  S IBT(IBC)="Admitted    :       "_IBADMIT,IBC=IBC+1
 | 
|---|
| 55 |  S IBT(IBC)="Discharged  :       "_IBDISC,IBC=IBC+1
 | 
|---|
| 56 |  Q
 | 
|---|
| 57 | PAT2 ; patient demographic data, admission and discharge date
 | 
|---|
| 58 |  N VAERR,VADM,DFN,IBNAME,IBID,IBADMIT,IBPARENT,IBDISC,VA
 | 
|---|
| 59 |  S IBT(IBC)=" ",IBC=IBC+1,(IBADMIT,IBDISC)=""
 | 
|---|
| 60 |  S DFN=+$P(IBND,"^",2) D DEM^VADPT I VAERR K VADM
 | 
|---|
| 61 |  S IBNAME=$G(VADM(1)),IBID=$G(VA("PID"))
 | 
|---|
| 62 |  S IBPARENT=$P(IBND,"^",16) I $G(IBPARENT) D
 | 
|---|
| 63 |  .N IBND S IBND=$G(^IB(IBPARENT,0))
 | 
|---|
| 64 |  .S Y=$P(IBND,"^",17) D DD^%DT S IBADMIT=Y
 | 
|---|
| 65 |  .D DISC^IBAMTC2 I IBDISC S Y=IBDISC D DD^%DT S IBDISC=Y
 | 
|---|
| 66 |  S IBT(IBC)="Patient Name:       "_IBNAME,IBC=IBC+1
 | 
|---|
| 67 |  S IBT(IBC)="Patient Id  :       "_IBID,IBC=IBC+1
 | 
|---|
| 68 |  S IBT(IBC)="Admitted    :       "_IBADMIT,IBC=IBC+1
 | 
|---|
| 69 |  S IBT(IBC)="Discharged  :       "_IBDISC,IBC=IBC+1
 | 
|---|
| 70 |  Q
 | 
|---|
| 71 | PR(STR,LEN) ; pad right
 | 
|---|
| 72 |  N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
 | 
|---|
| 73 |  Q STR_$G(B)
 | 
|---|