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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1IBCF12 ;ALB/AAS - PRINT BILL CONT. ;24 MAY 90
2 ;;2.0;INTEGRATED BILLING;**133,210**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;MAP TO DGCRP2
6 ;
7 ;Build ^Utility array of data to print in Block 20
8 ; Print Medicare statment on bottom 4 of 23 lines
9 ; Starting from top print the following, starting and finishing on
10 ; same page.
11 ; Print Revenue codes and subtotal
12 ; Print Additional CPT/ICD codes
13 ; Print offset and totals
14 ; Print Opt visit dates
15 ;
16 ;^Utility(...)=free text^pointer to rev or date of additional code^additional code variable pointer^"c" if additional code^executable code
17 ; =null ;blank line
18% ;
19 K ^UTILITY($J) S DGLCNT=0,DGSM=1 D SM^IBCU I 'DGSM D
20 .; -dgsm=1 print medicare statement
21 .; -dgsm=2 print NSC statement
22 .; -dgsm=3 print both statements
23 .S DGRNODE=$G(^DGCR(399.3,$P(^DGCR(399,IBIFN,0),"^",7),0))
24 .I $P(^DGCR(399,IBIFN,0),"^",11)="i",$P(DGRNODE,"^",8) S DGSM=1
25 .I $P(DGRNODE,"^",9) S DGSM=DGSM+2
26 .Q
27 D ^IBCF14:DGSM
28 D REVCOD
29 D TOTAL
30 D ADDCOD:$O(^DGCR(399,IBIFN,"CP",0))
31 D OPVIS:$O(^DGCR(399,IBIFN,"OP",0))
32 I DGLCNT<18 D FILL
33 S DGCNT=0,DGPAG=1,DGTOTPAG=DGLCNT/23 S:$P(DGTOTPAG,".",2) DGTOTPAG=DGTOTPAG\1+1
34 Q
35 ;
36REVCOD ;I $D(IBIP) S X=IBLS_" DAY"_$S(IBLS>1:"S ",1:" ")_$S(IBBS'=IBU:IBBS,1:"INPATIENT CARE") D SET
37 I $D(IBIP) S X=IBLS_" DAY"_$S(IBLS>1:"S ",1:" ")_"INPATIENT CARE" D SET
38 S X="" D SET
39 S DGBS=""
40 F I=0:0 S DGBS=$O(^DGCR(399,IBIFN,"RC","ABS",DGBS)) Q:'DGBS I $D(^DGCR(399.1,DGBS,0)) S X=$P(^DGCR(399.1,DGBS,0),"^") D SET,RCODE
41 ;
42 ; -loop thru all REV CODES and print those with no bedsection
43 S DGCNT=0,DGDA=0 F I=0:0 S DGDA=$O(^DGCR(399,IBIFN,"RC",DGDA)) Q:'DGDA I $D(^(DGDA,0)),'$P(^(0),U,5) S X="^"_DGDA D SET
44 S X="^^^^W !,""SUBTOTAL"",?39,$S(IB(""U1"")']"""":"""",$P(IB(""U1""),U,1)]"""":$J($P(IB(""U1""),U,1),9,2),1:$J(0,9,2))" D SET
45 Q
46 ;
47 ;Input: DGBS - bedsection, IBIFN - Bill/Claim
48RCODE ;Find revenue codes sorted by bedsection
49 N DGRV,DGDA,IBCODE
50 S DGRV=0 F S DGRV=$O(^DGCR(399,IBIFN,"RC","ABS",DGBS,DGRV)) Q:'DGRV D
51 . S DGDA=0 F S DGDA=$O(^DGCR(399,IBIFN,"RC","ABS",DGBS,DGRV,DGDA)) Q:'DGDA D
52 .. S X=U_DGDA D SET
53 .. S IBCODE=$P($G(^DGCR(399,IBIFN,"RC",DGDA,0)),U,6) D:IBCODE>0
54 ... S X=" Procedure: "_$P($$CPT^IBACSV(IBCODE),U)
55 ... D SET
56 Q
57ADDCOD ;Find additional codes
58 Q:'$D(IBPROC)#2 Q:IBPROC<4
59 D RSPACE
60 I DGRSPAC<(IBPROC-2) D FILL
61 S X="" D SET
62 S X="ADDITIONAL PROCEDURE CODES:" D SET
63 S J="" F I=1:1 S J=$O(IBPROC(J)) Q:'J I I>3 S X="^"_$P(IBPROC(J),"^",2)_"^"_$P(IBPROC(J),"^")_"^C" D SET
64 Q
65 ;
66TOTAL ;Find offsets and Totals
67 D RSPACE
68 I DGRSPAC<$S($P(IB("U1"),"^",2):4,1:2) D FILL
69 S X="" D SET
70 I $P(IB("U1"),"^",2) S X="^^^^W !,""LESS "",$P(IB(""U1""),""^"",3),?39,$J($P(IB(""U1""),""^"",2),9,2)" D SET S X="" D SET
71 S X="^^^^W !,""TOTAL"",?31,$S(+$P(IBEPAR(1),""^"",10):""001"",1:""""),?39,$J($P(IB(""U1""),""^"")-$P(IB(""U1""),""^"",2),9,2)" D SET
72 Q
73 ;
74OPVIS ;Find outpatient Visit dates
75 D RSPACE
76 S DGCNT=0 F I=0:0 S I=$O(^DGCR(399,IBIFN,"OP",I)) Q:'I S DGCNT=DGCNT+1
77 S DGCNT=DGCNT/3 I $P(DGCNT,".",2)]"" S DGCNT=DGCNT\1+1
78 I DGRSPAC<(DGCNT+1) D FILL
79 S X="" D SET
80 S X="OP VISIT DATE(S) BILLED "
81 S IB01=0 F IB02=1:1 S IB01=$O(^DGCR(399,IBIFN,"OP",IB01)) Q:'IB01 S Y=IB01 X ^DD("DD") S X=X_Y_$S($O(^DGCR(399,IBIFN,"OP",IB01)):", ",1:"") I '(IB02#3) D SET S X=" "
82 I (IB02-1)#3 D SET
83 K IB01,IB02
84 Q
85 ;
86SET S DGLCNT=DGLCNT+1
87 I DGLCNT<24,DGSM,DGLCNT+$S(DGSM=1:5,DGSM=2:2,1:8)>23 S DGLCNT=24
88 G:$D(^UTILITY($J,"IB-RC",DGLCNT)) SET
89 S ^UTILITY($J,"IB-RC",DGLCNT)=X Q
90 Q
91 ;
92RSPACE ;Find remaining blank lines
93 S DGRSPAC=$S(DGLCNT<24:$S(DGSM=1:18,DGSM=2:21,DGSM=3:15,1:23)-DGLCNT,DGLCNT<47:46-DGLCNT,DGLCNT<70:69-DGLCNT,DGLCNT<93:92-DGLCNT,DGLCNT<116:115,1:138)
94 Q
95FILL ;fill space with blank lines so all will fit on page
96 F I=0:0 Q:($S(DGSM=1&(DGLCNT=18):1,DGSM=2&(DGLCNT=21):1,DGSM=3&(DGLCNT=15):1,1:0))!('(DGLCNT#23)) S X="" D SET
97 Q
Note: See TracBrowser for help on using the repository browser.