1 | IBCOIVM2 ;ALB/NLR - IB BILLING ACTIVITY (BULLETIN) ; 4-MAY-94
|
---|
2 | ;;Version 2.0 ; INTEGRATED BILLING ;**6**; 21-MAR-94
|
---|
3 | ;
|
---|
4 | BULL ; Generate a bulletin containing the report.
|
---|
5 | S XMSUB="IVM BILLING ACTIVITY"
|
---|
6 | S XMDUZ="INTEGRATED BILLING PACKAGE"
|
---|
7 | S XMTEXT="IBT("
|
---|
8 | S XMY($P($G(^IBE(350.9,1,4)),"^",7))=""
|
---|
9 | S XMY(DUZ)=""
|
---|
10 | ;
|
---|
11 | ; - set up report header
|
---|
12 | S IBT(1)=$J("",55)_"IVM BILLING ACTIVITY"
|
---|
13 | S IBT(2)=" "
|
---|
14 | S X=$$SITE^VASITE
|
---|
15 | S X=$E("Facility: "_$P(X,"^",2)_" ("_$P(X,"^",3)_")"_$J("",100),1,112)
|
---|
16 | S IBT(3)=X_"Run Date: "_$$DAT1^IBOUTL(DT)
|
---|
17 | S X="Types ==> I:Inpatient, O:Outpatient, P:Prosthetics, R:Pharmacy Refill"
|
---|
18 | S IBT(4)=X_$J("",12)_"Note: '*' after the Bill # denotes a closed bill"
|
---|
19 | S IBT(5)=" "
|
---|
20 | S IBT(6)=$$DASH^IBCOIVM1
|
---|
21 | S IBT(7)=$J("",55)_"Bill"_$J("",30)_"Date"_$J("",14)_"Amt"_$J("",15)_"Amt"
|
---|
22 | S X=" Patient Name"_$J("",15)_"SSN Bill # Type Bill From - To"
|
---|
23 | S IBT(8)=X_" Generated"_$J("",10)_"Billed"_$J("",11)_"Collected"
|
---|
24 | S IBT(9)=$$DASH^IBCOIVM1,IBC=9
|
---|
25 | I '$D(^TMP("IBOIVM",$J)) D SET(" ") S IBX=$J("",25)_"<< NO PATIENTS WITH POLICIES IDENTIFIED BY IVM >>" D SET(IBX) G DELQ
|
---|
26 | ;
|
---|
27 | ; - set up report body
|
---|
28 | S (IBAB,IBAC)=0
|
---|
29 | S IBNA="" F S IBNA=$O(^TMP("IBOIVM",$J,IBNA)) Q:IBNA="" D
|
---|
30 | .D SET(" ")
|
---|
31 | .S IBX=$E($E($P(IBNA,"^"),1,25)_$J("",25),1,25)_" "
|
---|
32 | .S IBX=IBX_$E($P(IBNA,"^",2)_$J("",14),1,14)
|
---|
33 | .I $D(^TMP("IBOIVM",$J,IBNA,0)) D SET(IBX_$J("",12)_"<< BILLS NOT YET GENERATED AGAINST IVM POLICIES >>") Q
|
---|
34 | .S (IBF,IBIFN)=0 F S IBIFN=$O(^TMP("IBOIVM",$J,IBNA,IBIFN)) Q:'IBIFN D
|
---|
35 | ..F IBI=0,"S","U" S IBND(IBI)=$G(^DGCR(399,IBIFN,IBI))
|
---|
36 | ..S:IBF IBX=$J("",41)
|
---|
37 | ..S IBX=IBX_$E($P(IBND(0),"^")_$J("",10),1,10)
|
---|
38 | ..S IBX=IBX_$S($$CLO^PRCAFN(IBIFN)>0:"*",1:" ")_" "
|
---|
39 | ..S IBX=IBX_$E($$BTYP^IBCOIVM1(IBIFN,IBND(0))_" ")_" "
|
---|
40 | ..S IBX=IBX_$E($$DAT1^IBOUTL(+IBND("U"))_$J("",8),1,8)_" "
|
---|
41 | ..S IBX=IBX_$E($$DAT1^IBOUTL($P(IBND("U"),"^",2))_$J("",8),1,8)_" "
|
---|
42 | ..S IBX=IBX_$E($$DAT1^IBOUTL($P(IBND("S"),"^",12))_$J("",8),1,8)
|
---|
43 | ..S IBZ=$$ORI^PRCAFN(IBIFN),IBAB=IBAB+IBZ
|
---|
44 | ..S IBX=IBX_$J("",8)_$J(IBZ,10,2)
|
---|
45 | ..S IBZ=$$TPR^PRCAFN(IBIFN),IBAC=IBAC+IBZ
|
---|
46 | ..S IBX=IBX_" "_$J(IBZ,10,2)
|
---|
47 | ..D SET(IBX)
|
---|
48 | ..S IBF=1
|
---|
49 | ;
|
---|
50 | I 'IBAB,'IBAC G DELQ
|
---|
51 | ; - set up total amounts billed and collected
|
---|
52 | S IBX=$J("",102)_"___________ ___________"
|
---|
53 | D SET(IBX)
|
---|
54 | D SET(" ")
|
---|
55 | S IBX=$J("",63)_"Total Amounts Billed and Collected:"
|
---|
56 | S X=IBAB,X2="2$",X3=16 D COMMA^%DTC S IBX=IBX_X
|
---|
57 | S X=IBAC,X2="2$",X3=16 D COMMA^%DTC S IBX=IBX_X
|
---|
58 | D SET(IBX)
|
---|
59 | ;
|
---|
60 | ; - deliver and quit
|
---|
61 | DELQ D ^XMD
|
---|
62 | K IBAB,IBAC,IBC,IBF,IBI,IBIFN,IBNA,IBT,IBX,IBZ,X,X2,X3,XMSUB,XMDUZ,XMY,XMTEXT,Y
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | ;
|
---|
66 | SET(X) ; Set X into the IBT( array.
|
---|
67 | S IBC=IBC+1,IBT(IBC)=X
|
---|
68 | Q
|
---|