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

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1IBCOIVM2 ;ALB/NLR - IB BILLING ACTIVITY (BULLETIN) ; 4-MAY-94
2 ;;Version 2.0 ; INTEGRATED BILLING ;**6**; 21-MAR-94
3 ;
4BULL ; 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
61DELQ 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 ;
66SET(X) ; Set X into the IBT( array.
67 S IBC=IBC+1,IBT(IBC)=X
68 Q
Note: See TracBrowser for help on using the repository browser.