source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCORC2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1IBCORC2 ;ALB/CPM - RANK INSURANCE CARRIERS (BULLETIN) ; 30-JUN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4BULL ; Generate a bulletin containing the report.
5 S XMSUB="RANKING INSURANCE CARRIERS"
6 S XMDUZ="INTEGRATED BILLING PACKAGE"
7 S XMTEXT="IBT("
8 S XMY($P($G(^IBE(350.9,1,4)),"^",5))=""
9 S XMY(DUZ)=""
10 ;
11 ; - set up report header
12 S X="Ranking Of The Top "_IBNR_" Insurance Carriers By Total Amount Billed"
13 S IBT(1)=$J("",80-$L(X)\2)_X
14 S IBT(2)=" "
15 S X=$$SITE^VASITE,X=$E($P(X,"^",2)_" ("_$P(X,"^",3)_")"_$J("",46),1,46)
16 S IBT(3)=" Facility: "_X_"Run Date: "_$$DAT1^IBOUTL(DT)
17 S IBT(4)="Date Range: "_$$DAT1^IBOUTL(IBABEG)_" thru "_$$DAT1^IBOUTL(IBAEND)_$J("",28)_"Page: 1 of 1"
18 S IBT(5)=" "
19 S IBT(6)=$$DASH^IBCORC1
20 S IBT(7)=" Rank"_$J("",14)_"Insurance Carrier"_$J("",18)_"Total Amt Billed"
21 S IBT(8)=$$DASH^IBCORC1
22 S IBT(9)=" ",IBC=9
23 ;
24 ; - set up report body
25 S (IBTAMT,IBCNT)=0,IBAMT=""
26 F S IBAMT=$O(^TMP("IBORIC",$J,"AMT",IBAMT)) Q:IBAMT=""!(IBCNT>IBNR) D
27 .S IBINS=0 F S IBINS=$O(^TMP("IBORIC",$J,"AMT",IBAMT,IBINS)) Q:'IBINS!(IBCNT>IBNR) D
28 ..S IBCNT=IBCNT+1 Q:IBCNT>IBNR
29 ..S IBAMTP=-IBAMT,IBTAMT=IBTAMT+IBAMTP
30 ..S IBINS0=$G(^DIC(36,IBINS,0)),IBINSA=$G(^(.11))
31 ..S IBC=IBC+1,IBT(IBC)=" "
32 ..S X=IBAMTP,X2="2$",X3=15 D COMMA^%DTC
33 ..S IBC=IBC+1,IBT(IBC)=$J(IBCNT,4)_"."_$J("",15)_$E($S($P(IBINS0,"^")]"":$P(IBINS0,"^"),1:"CARRIER UNKNOWN")_$J("",34),1,34)_X
34 ..D INSBULL(IBINSA)
35 ;
36 ; - set up totals
37 S IBC=IBC+1,IBT(IBC)=" "
38 S X=IBTAMT,X2="2$",X3=15 D COMMA^%DTC
39 S IBC=IBC+1,IBT(IBC)="Total Amount Billed to all Ranked Carriers:"_$J("",11)_X
40 ;
41 ; - deliver and quit
42 D ^XMD
43 K IBAMT,IBAMTP,IBCNT,IBINS0,IBINSA,IBC,IBT,IBTAMT,X,XMSUB,XMDUZ,XMY,XMTEXT,Y
44 Q
45 ;
46INSBULL(X) ; Display Insurance Company name and address for bulletin.
47 ; Input: X -- .11 node of ins company entry in file #36
48 S:$P(X,"^")]"" IBC=IBC+1,IBT(IBC)=$J("",20)_$P(X,"^")
49 S:$P(X,"^",2)]"" IBC=IBC+1,IBT(IBC)=$J("",20)_$P(X,"^",2)
50 S:$P(X,"^",3)]"" IBC=IBC+1,IBT(IBC)=$J("",20)_$P(X,"^",3)
51 S IBC=IBC+1,IBT(IBC)=$J("",20)_$P(X,"^",4)
52 S:$P(X,"^",4)]""&($P(X,"^",5)]"") IBT(IBC)=IBT(IBC)_", "
53 S IBT(IBC)=IBT(IBC)_$P($G(^DIC(5,+$P(X,"^",5),0)),"^")
54 S:$P(X,"^",6)]""&($P(X,"^",4)]""!($P(X,"^",5)]"")) IBT(IBC)=IBT(IBC)_" "
55 S IBT(IBC)=IBT(IBC)_$P(X,"^",6)
56 Q
Note: See TracBrowser for help on using the repository browser.