source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTC3.m@ 632

Last change on this file since 632 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1IBAMTC3 ;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.
4BULLET1 N IBT,IBC,XMSUB,XMY,XMDUZ,XMTEXT
5 S IBC=1,IBDUZ=$G(DUZ)
6 D HDR1,PAT1,CHRG1,MAIL^IBAERR1
7 Q
8BULLET2 N IBT,IBC,XMSUB,XMY,XMDUZ,XMTEXT
9 S IBC=1,IBDUZ=$G(DUZ)
10 D HDR2,PAT2,CHRG2,MAIL^IBAERR1
11 Q
12MAIL ; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CALL MAIL^IBAERR1
13 ; F I=1:1:(IBC-1) W IBT(I),!
14 ; Q
15HDR1 ;
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
19HDR2 ;
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
23CHRG2 ;
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
31CHRG1 ;
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
39CHGDATA ;
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
45PAT1 ; 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
57PAT2 ; 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
71PR(STR,LEN) ; pad right
72 N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
73 Q STR_$G(B)
Note: See TracBrowser for help on using the repository browser.