- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDB11.m
r628 r636 1 1 IBJDB11 ;ALB/CPM - BILLING LAG TIME REPORT (COMPILE) ; 27-DEC-96 2 ;;2.0;INTEGRATED BILLING;**69,100,118 ,165**;21-MAR-942 ;;2.0;INTEGRATED BILLING;**69,100,118**;21-MAR-94 3 3 ; 4 4 EN ; - Entry point from IBJDB1. … … 28 28 .S IBTY=$S($P(IBN0,U,5)<3:"IN",1:"OP") ; Inpatient or outpatient claim? 29 29 .; 30 .;- Get date PTF transmitted. 31 .S IBPTF="" I IBTY="IN" S IBPTF=$$PTF($P(IBN0,U,8)) Q:'IBPTF 30 .; - Get most recent date PTF transmitted. 31 .I IBTY="IN" D Q:'IBPTF!('IBPTF&($P(IBAUTH,U,2))) 32 ..S IBPTF=$P(IBN0,U,8) I 'IBPTF Q 33 ..S IBPTF=$O(^DGP(45.83,"C",IBPTF,9999999),-1)\1 I IBPTF Q 34 ..S IBPTF=$P($G(^DGP(45.83,IBPTF,0)),U,2)\1 32 35 .; 33 36 .; - Get other claim info and build date line. … … 53 56 ..; - Get most recent check out date that has not been marked as non 54 57 ..; billable by Claims Tracking; quit if there isn't one. 55 ..I IBTY="OP" D K IBCL,IBCL1 Q:'IBCHK 56 ...D CL(IBN) ;GET LIST OF CLINICS FOR THIS BILL 58 ..I IBTY="OP" D Q:'IBCHK 57 59 ...S IBCHK=0,IBX1=IBX-.0001 58 60 ...F S IBX1=$O(^SCE("ADFN",DFN,IBX1)) Q:'IBX1!((IBX1\1)>IBX) D 59 61 ....S IBX2=0 F S IBX2=$O(^SCE("ADFN",DFN,IBX1,IBX2)) Q:'IBX2 D 60 .....;61 .....;CHECK TO SEE IF CLINICS MATCH62 .....S IBCL1=+$P($G(^SCE(IBX2,0)),U,4) Q:'$D(IBCL(IBCL1))63 62 .....I $P($G(^IBT(356,+$O(^IBT(356,"ASCE",IBX2,0)),0)),U,19) Q 64 .....S IBX3=$P($G(^SCE(IBX2,0)),U,7)\1 I IBX3,IBX3'>$P(IBAUTH,U,2) D 65 ...... S:IBX3>IBCHK IBCHK=IBX3 Q 63 .....S IBX3=$P($G(^SCE(IBX2,0)),U,7)\1 I IBX3 S IBCHK=IBX3 66 64 ..; 67 ..S X=$S(IBTY="IN":IBX1_U_ +IBPTF,1:IBX_U_IBCHK)_U_IBDAT65 ..S X=$S(IBTY="IN":IBX1_U_IBPTF,1:IBX_U_IBCHK)_U_IBDAT 68 66 ..S IBPOL1=$S(IBPOL>+X:1,1:0) ; Policy found after treatment. 69 67 ..; … … 112 110 ..F Y=1:1 S Z=$P(IBSEL1,",",Y) Q:'Z D 113 111 ...I IBRPT="D" D 114 ....S IBBN=$P(IBN0,U) S:IBPOL1 IBBN=IBBN_"*" 115 ....S Y(Z)=IBBN_U_Y(Z),Y1(Z)=$G(Y1(Z))+1 112 ....S Y(Z)=$P(IBN0,U)_U_Y(Z)_U_$S(IBPOL1:"*",1:""),Y1(Z)=$G(Y1(Z))+1 116 113 ....S ^TMP("IBJDB1",$J,IBDIV,IBTY,Z,$P(IBDFN,U)_"@@"_$P(IBDFN,U,9),Y1(Z))=Y(Z) 117 114 ...E S IBCT(IBDIV,IBTY,Z)=IBCT(IBDIV,IBTY,Z)+1,IBTL(IBDIV,IBTY,Z)=IBTL(IBDIV,IBTY,Z)+Y(Z) … … 147 144 ; 148 145 FP ; - Get first payment date, if available. 149 I '$P($G(^PRCA(430,IBN,7)),U,7) G DC; No payments made.146 I '$P($G(^PRCA(430,IBN,7)),U,7) G CL ; No payments made. 150 147 S (IBPAY,IBT)=0 F S IBT=$O(^PRCA(433,"C",IBN,IBT)) Q:'IBT D Q:IBPAY 151 148 .S IBT0=$G(^PRCA(433,IBT,0)),IBT1=$G(^(1)) … … 154 151 .S X=$S(+IBT1:+IBT1,1:$P(IBT1,U,9)\1),$P(VAL,U,4)=X,IBPAY=1 155 152 ; 156 DC; - Get date AR closed.153 CL ; - Get date AR closed. 157 154 S X=$$CLO^PRCAFN(IBN) I X>0 S $P(VAL,U,5)=X 158 155 ; … … 170 167 I IBSEL[(","_X_","),X1'<IBBDT,X1'>IBEDT S X2=1 171 168 DLQ Q X2 172 ;173 ;174 PTF(X) ; - Get most recent PTF transmission date.175 ; Input: X=IEN of PTF file entry.176 ; Output: Y=PTF date.177 N I,K,Y178 S Y=0 G:'$O(^DGP(45.83,"C",+X,0)) PTFQ179 S I=0 F S I=$O(^DGP(45.83,"C",X,I)) Q:'I D180 .S J=$P($G(^DGP(45.83,I,0)),U,2)\1 Q:J>$P(IBAUTH,U,2) S:J K(J)=""181 S I=0 F S I=$O(K(I)) Q:'I S Y=I182 ;183 PTFQ Q Y184 ;185 CL(IBN) ; - Get the clinics for bill.186 N I,J K IBCL ; IBCL=Bill clinic array.187 S I=0 F S I=$O(^DGCR(399,IBN,"CP",I)) Q:I="" D188 .S J=$P($G(^DGCR(399,IBN,"CP",I,0)),U,7) S:J IBCL(J)=""189 Q
Note:
See TracChangeset
for help on using the changeset viewer.