- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDB11.m
r613 r623 1 IBJDB11 ;ALB/CPM - BILLING LAG TIME REPORT (COMPILE) ; 27-DEC-96 2 ;;2.0;INTEGRATED BILLING;**69,100,118,165**;21-MAR-94 3 ; 4 EN ; - Entry point from IBJDB1. 5 ; 6 ; - 7 I IBRPT="D" F X=2,3,4,6,7,8 S:IBSEL[X IBSEL=IBSEL_X_"I," 8 I 'IBSORT D INIT(0) G REV 9 S X=0 F S X=$S('VAUTD:$O(VAUTD(X)),1:$O(^DG(40.8,X))) Q:'X D INIT(X) 10 ; 11 REV ; - Review all claims in file #399. 12 S IBN=0 F S IBN=$O(^DGCR(399,IBN)) Q:'IBN S IBN0=$G(^(IBN,0)) D Q:IBQ 13 .I IBN#100=0 S IBQ=$$STOP^IBOUTL("Billing Lag Time Report") Q:IBQ 14 .; 15 .I $P($G(^PRCA(430,IBN,0)),U,2)'=9 Q ; Not an RI claim. 16 .I $P(IBN0,U,13)<3 Q ; Not authorized. 17 .I $P(IBN0,U,13)=7 Q ; Cancelled in IB. 18 .S X=$P($G(^PRCA(430,IBN,0)),U,8) I X=26!(X=39) Q ; Cancelled in AR. 19 .; 20 .; - Does claim meet report criteria? 21 .S IBAUTH=$$AUTH(IBN) I 'IBAUTH Q 22 .; 23 .; - Get division, if necessary. 24 .I 'IBSORT S IBDIV=0 25 .E S IBDIV=$$DIV^IBJDF2(IBN) I 'IBDIV S IBDIV=+$$PRIM^VASITE() 26 .I IBSORT,'VAUTD,'$D(VAUTD(IBDIV)) Q ; Not a selected division. 27 .; 28 .S IBTY=$S($P(IBN0,U,5)<3:"IN",1:"OP") ; Inpatient or outpatient claim? 29 .; 30 .;- Get date PTF transmitted. 31 .S IBPTF="" I IBTY="IN" S IBPTF=$$PTF($P(IBN0,U,8)) Q:'IBPTF 32 .; 33 .; - Get other claim info and build date line. 34 .S IBDAT=$P(IBAUTH,U,2,5),DFN=+$P(IBN0,U,2),IBDFN=$G(^DPT(DFN,0)) 35 .S IBPOL=+$G(^DPT(DFN,.312,+$P($G(^DGCR(399,IBN,"MP")),U,2),1)) 36 .; 37 .; - Get care dates; quit if there are none. 38 .K IBDR S IBNU=$G(^DGCR(399,IBN,"U")) D 39 ..I IBTY="IN" S X=+$P(IBNU,U,2) S:'X X=+IBNU S:X IBDR(X)="" Q 40 ..I '$D(^DGCR(399,IBN,"OP")) D Q 41 ...S X=+$P(IBNU,U,2) S:X IBDR(X)="" S:+IBNU&(+IBNU'=X) IBDR(+IBNU)="" 42 ..S X=0 F S X=$O(^DGCR(399,IBN,"OP",X)) Q:'X S IBDR(X)="" 43 .I '$D(IBDR) Q 44 .; 45 .; - Calculate statistics for each care date. 46 .S IBX=0 F S IBX=$O(IBDR(IBX)) Q:'IBX D 47 ..; 48 ..; - Get discharge date. 49 ..I IBTY="IN" D 50 ...S IBX1=+$G(^DGPT(+$P(IBN0,U,8),70))\1 I IBX1 Q 51 ...S IBX1=+$O(^DGPM("APTT3",DFN,(IBX-.0001)))\1 I 'IBX1 S IBX1=IBX 52 ..; 53 ..; - Get most recent check out date that has not been marked as non 54 ..; 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 57 ...S IBCHK=0,IBX1=IBX-.0001 58 ...F S IBX1=$O(^SCE("ADFN",DFN,IBX1)) Q:'IBX1!((IBX1\1)>IBX) D 59 ....S IBX2=0 F S IBX2=$O(^SCE("ADFN",DFN,IBX1,IBX2)) Q:'IBX2 D 60 .....; 61 .....;CHECK TO SEE IF CLINICS MATCH 62 .....S IBCL1=+$P($G(^SCE(IBX2,0)),U,4) Q:'$D(IBCL(IBCL1)) 63 .....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 66 ..; 67 ..S X=$S(IBTY="IN":IBX1_U_+IBPTF,1:IBX_U_IBCHK)_U_IBDAT 68 ..S IBPOL1=$S(IBPOL>+X:1,1:0) ; Policy found after treatment. 69 ..; 70 ..; - Check date line for at least one date within the user specified 71 ..; range; quit if there isn't any. 72 ..S IBDCHK=0 F Y=2:1:6 I $$DL(0,$P(X,U,Y)) S IBDCHK=1 Q 73 ..I 'IBDCHK Q 74 ..; 75 ..K D,Y,Z S IBSEL1="" 76 ..F Y=1:1:5 S Z(1)=$P(X,U,Y),Z(2)=$P(X,U,Y+1) D 77 ...; 78 ...; - Check out date/PTF transmission date. 79 ...I Y=1 D:Z(2) Q 80 ....S D(0)=$$FMDIFF^XLFDT(Z(2),Z(1)),Z=$S(IBTY="IN":5,1:1) 81 ....I $$DL(Z,Z(2)) S IBSEL1=IBSEL1_Z_",",Y(Z)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(0),1:D(0)) 82 ...; 83 ...; - Date authorized. 84 ...I Y=2 D:Z(1) Q 85 ....S D(1)=$$FMDIFF^XLFDT(Z(2),Z(1)),Z=$S(IBTY="IN":6,1:2) 86 ....I $$DL(Z,Z(2)) D 87 .....S Z1=$S(IBPOL1:Z_"I",1:Z),IBSEL1=IBSEL1_Z1_",",Y(Z1)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(1),1:D(1)) 88 .....I Z1=Z D 89 ......S Z2=Z_"I",IBSEL1=IBSEL1_Z2_",",Y(Z2)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(1),1:D(1)) 90 ...; 91 ...; - Date activated. 92 ...I Y=3 D:Z(2) Q 93 ....S D(2)=$$FMDIFF^XLFDT(Z(2),Z(1)) I $$DL(9,Z(2)) S IBSEL1=IBSEL1_"9,",Y(9)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(2),1:D(2)) 94 ...; 95 ...; - Payment date. 96 ...I Y=4 D:Z(2) Q 97 ....S D(3)=$$FMDIFF^XLFDT(Z(2),Z(1)),D(6)=$$FMDIFF^XLFDT(Z(2),+X) 98 ....F Z=$S(IBTY="IN":7,1:3),10 I $$DL(Z,Z(2)) D 99 .....S Z1=$S(IBPOL1&(Z<10):Z_"I",1:Z),Z2=$S(Z<10:6,1:3) 100 .....S IBSEL1=IBSEL1_Z1_",",Y(Z1)=$S(IBRPT="D":$S(Z2=3:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 101 .....I Z1=Z,Z<10 S Z3=Z_"I",IBSEL1=IBSEL1_Z3_",",Y(Z3)=$S(IBRPT="D":$S(Z2=3:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 102 ...; 103 ...; - Date closed. 104 ...I Z(2) D 105 ....S D(4)=$$FMDIFF^XLFDT(Z(2),Z(1)),D(5)=$$FMDIFF^XLFDT(Z(2),+X) 106 ....F Z=$S(IBTY="IN":8,1:4),11 I $$DL(Z,Z(2)) D 107 .....S Z1=$S(IBPOL1&(Z<11):Z_"I",1:Z),Z2=$S(Z<11:5,1:4) 108 .....S IBSEL1=IBSEL1_Z1_",",Y(Z1)=$S(IBRPT="D":$S(Z2=4:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 109 .....I Z1=Z,Z<11 S Z3=Z_"I",IBSEL1=IBSEL1_Z3_",",Y(Z3)=$S(IBRPT="D":$S(Z2=4:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 110 ..; 111 ..; - Save data for detail or summary report(s). 112 ..F Y=1:1 S Z=$P(IBSEL1,",",Y) Q:'Z D 113 ...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 116 ....S ^TMP("IBJDB1",$J,IBDIV,IBTY,Z,$P(IBDFN,U)_"@@"_$P(IBDFN,U,9),Y1(Z))=Y(Z) 117 ...E S IBCT(IBDIV,IBTY,Z)=IBCT(IBDIV,IBTY,Z)+1,IBTL(IBDIV,IBTY,Z)=IBTL(IBDIV,IBTY,Z)+Y(Z) 118 ; 119 Q 120 ; 121 INIT(X) ; - Initialize summary accumulators/detail division nodes. 122 I IBRPT="D" S ^TMP("IBJDB1",$J,X)="" Q 123 F Y=1:1:4,9,10,11,"2I","3I","4I" S (IBCT(X,"OP",Y),IBTL(X,"OP",Y))=0 124 F Y=5:1:11,"6I","7I","8I" S (IBCT(X,"IN",Y),IBTL(X,"IN",Y))=0 125 Q 126 ; 127 AUTH(IBN) ; - Is this an authorized claim? 128 ; Input: IBN=Pointer to the AR in file #430 129 ; Output: VAL=1^2^3^4^5, where: 130 ; 1=1-Authorized claim 131 ; 0-Not an authorized claim 132 ; 2=Date AR was authorized 133 ; 3=Date AR was activated 134 ; 4=AR first payment date 135 ; 5=Date AR was closed 136 ; 137 N IBPAY,IBT,IBT0,IBT1,VAL,X 138 S VAL=0 I '$G(IBN) G AUTHQ 139 ; 140 ; - Get date authorized (required). 141 S X=$P($G(^DGCR(399,IBN,"S")),U,10) G:'X AUTHQ S VAL="1^"_X 142 ; 143 ; - Get date activated, if available. 144 S X=$P($G(^PRCA(430,IBN,6)),U,21) I X S $P(VAL,U,3)=X\1 G FP 145 S X=$P($G(^PRCA(430,IBN,9)),U,3) I X S $P(VAL,U,3)=X\1 G FP 146 S X=$P($G(^PRCA(430,IBN,0)),U,10) I X S $P(VAL,U,3)=X\1 147 ; 148 FP ; - Get first payment date, if available. 149 I '$P($G(^PRCA(430,IBN,7)),U,7) G DC ; No payments made. 150 S (IBPAY,IBT)=0 F S IBT=$O(^PRCA(433,"C",IBN,IBT)) Q:'IBT D Q:IBPAY 151 .S IBT0=$G(^PRCA(433,IBT,0)),IBT1=$G(^(1)) 152 .I $P(IBT0,U,4)'=2 Q ; Not complete. 153 .I $P(IBT1,U,2)'=2,$P(IBT1,U,2)'=34 Q ; Not a payment. 154 .S X=$S(+IBT1:+IBT1,1:$P(IBT1,U,9)\1),$P(VAL,U,4)=X,IBPAY=1 155 ; 156 DC ; - Get date AR closed. 157 S X=$$CLO^PRCAFN(IBN) I X>0 S $P(VAL,U,5)=X 158 ; 159 ; - Is there a payment date AND a closed date for this claim? 160 I '$P(VAL,U,4),$P(VAL,U,5) S $P(VAL,U)=0 161 ; 162 AUTHQ Q VAL 163 ; 164 DL(X,X1) ; - Is line item date valid for report? 165 ; Input: X=Line item number (or 0), X1=Line item date 166 ; Output: 1=valid, 0=invalid 167 ; *Requires pre-defined variables IBBDT, IBEDT, and IBSEL 168 S X2=0 I 'X1 G DLQ 169 I 'X S:X1'<IBBDT&(X1'>IBEDT) X2=1 G DLQ 170 I IBSEL[(","_X_","),X1'<IBBDT,X1'>IBEDT S X2=1 171 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,Y 178 S Y=0 G:'$O(^DGP(45.83,"C",+X,0)) PTFQ 179 S I=0 F S I=$O(^DGP(45.83,"C",X,I)) Q:'I D 180 .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=I 182 ; 183 PTFQ Q Y 184 ; 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="" D 188 .S J=$P($G(^DGCR(399,IBN,"CP",I,0)),U,7) S:J IBCL(J)="" 189 Q 1 IBJDB11 ;ALB/CPM - BILLING LAG TIME REPORT (COMPILE) ; 27-DEC-96 2 ;;2.0;INTEGRATED BILLING;**69,100,118**;21-MAR-94 3 ; 4 EN ; - Entry point from IBJDB1. 5 ; 6 ; - 7 I IBRPT="D" F X=2,3,4,6,7,8 S:IBSEL[X IBSEL=IBSEL_X_"I," 8 I 'IBSORT D INIT(0) G REV 9 S X=0 F S X=$S('VAUTD:$O(VAUTD(X)),1:$O(^DG(40.8,X))) Q:'X D INIT(X) 10 ; 11 REV ; - Review all claims in file #399. 12 S IBN=0 F S IBN=$O(^DGCR(399,IBN)) Q:'IBN S IBN0=$G(^(IBN,0)) D Q:IBQ 13 .I IBN#100=0 S IBQ=$$STOP^IBOUTL("Billing Lag Time Report") Q:IBQ 14 .; 15 .I $P($G(^PRCA(430,IBN,0)),U,2)'=9 Q ; Not an RI claim. 16 .I $P(IBN0,U,13)<3 Q ; Not authorized. 17 .I $P(IBN0,U,13)=7 Q ; Cancelled in IB. 18 .S X=$P($G(^PRCA(430,IBN,0)),U,8) I X=26!(X=39) Q ; Cancelled in AR. 19 .; 20 .; - Does claim meet report criteria? 21 .S IBAUTH=$$AUTH(IBN) I 'IBAUTH Q 22 .; 23 .; - Get division, if necessary. 24 .I 'IBSORT S IBDIV=0 25 .E S IBDIV=$$DIV^IBJDF2(IBN) I 'IBDIV S IBDIV=+$$PRIM^VASITE() 26 .I IBSORT,'VAUTD,'$D(VAUTD(IBDIV)) Q ; Not a selected division. 27 .; 28 .S IBTY=$S($P(IBN0,U,5)<3:"IN",1:"OP") ; Inpatient or outpatient claim? 29 .; 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 35 .; 36 .; - Get other claim info and build date line. 37 .S IBDAT=$P(IBAUTH,U,2,5),DFN=+$P(IBN0,U,2),IBDFN=$G(^DPT(DFN,0)) 38 .S IBPOL=+$G(^DPT(DFN,.312,+$P($G(^DGCR(399,IBN,"MP")),U,2),1)) 39 .; 40 .; - Get care dates; quit if there are none. 41 .K IBDR S IBNU=$G(^DGCR(399,IBN,"U")) D 42 ..I IBTY="IN" S X=+$P(IBNU,U,2) S:'X X=+IBNU S:X IBDR(X)="" Q 43 ..I '$D(^DGCR(399,IBN,"OP")) D Q 44 ...S X=+$P(IBNU,U,2) S:X IBDR(X)="" S:+IBNU&(+IBNU'=X) IBDR(+IBNU)="" 45 ..S X=0 F S X=$O(^DGCR(399,IBN,"OP",X)) Q:'X S IBDR(X)="" 46 .I '$D(IBDR) Q 47 .; 48 .; - Calculate statistics for each care date. 49 .S IBX=0 F S IBX=$O(IBDR(IBX)) Q:'IBX D 50 ..; 51 ..; - Get discharge date. 52 ..I IBTY="IN" D 53 ...S IBX1=+$G(^DGPT(+$P(IBN0,U,8),70))\1 I IBX1 Q 54 ...S IBX1=+$O(^DGPM("APTT3",DFN,(IBX-.0001)))\1 I 'IBX1 S IBX1=IBX 55 ..; 56 ..; - Get most recent check out date that has not been marked as non 57 ..; billable by Claims Tracking; quit if there isn't one. 58 ..I IBTY="OP" D Q:'IBCHK 59 ...S IBCHK=0,IBX1=IBX-.0001 60 ...F S IBX1=$O(^SCE("ADFN",DFN,IBX1)) Q:'IBX1!((IBX1\1)>IBX) D 61 ....S IBX2=0 F S IBX2=$O(^SCE("ADFN",DFN,IBX1,IBX2)) Q:'IBX2 D 62 .....I $P($G(^IBT(356,+$O(^IBT(356,"ASCE",IBX2,0)),0)),U,19) Q 63 .....S IBX3=$P($G(^SCE(IBX2,0)),U,7)\1 I IBX3 S IBCHK=IBX3 64 ..; 65 ..S X=$S(IBTY="IN":IBX1_U_IBPTF,1:IBX_U_IBCHK)_U_IBDAT 66 ..S IBPOL1=$S(IBPOL>+X:1,1:0) ; Policy found after treatment. 67 ..; 68 ..; - Check date line for at least one date within the user specified 69 ..; range; quit if there isn't any. 70 ..S IBDCHK=0 F Y=2:1:6 I $$DL(0,$P(X,U,Y)) S IBDCHK=1 Q 71 ..I 'IBDCHK Q 72 ..; 73 ..K D,Y,Z S IBSEL1="" 74 ..F Y=1:1:5 S Z(1)=$P(X,U,Y),Z(2)=$P(X,U,Y+1) D 75 ...; 76 ...; - Check out date/PTF transmission date. 77 ...I Y=1 D:Z(2) Q 78 ....S D(0)=$$FMDIFF^XLFDT(Z(2),Z(1)),Z=$S(IBTY="IN":5,1:1) 79 ....I $$DL(Z,Z(2)) S IBSEL1=IBSEL1_Z_",",Y(Z)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(0),1:D(0)) 80 ...; 81 ...; - Date authorized. 82 ...I Y=2 D:Z(1) Q 83 ....S D(1)=$$FMDIFF^XLFDT(Z(2),Z(1)),Z=$S(IBTY="IN":6,1:2) 84 ....I $$DL(Z,Z(2)) D 85 .....S Z1=$S(IBPOL1:Z_"I",1:Z),IBSEL1=IBSEL1_Z1_",",Y(Z1)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(1),1:D(1)) 86 .....I Z1=Z D 87 ......S Z2=Z_"I",IBSEL1=IBSEL1_Z2_",",Y(Z2)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(1),1:D(1)) 88 ...; 89 ...; - Date activated. 90 ...I Y=3 D:Z(2) Q 91 ....S D(2)=$$FMDIFF^XLFDT(Z(2),Z(1)) I $$DL(9,Z(2)) S IBSEL1=IBSEL1_"9,",Y(9)=$S(IBRPT="D":Z(1)_U_Z(2)_U_D(2),1:D(2)) 92 ...; 93 ...; - Payment date. 94 ...I Y=4 D:Z(2) Q 95 ....S D(3)=$$FMDIFF^XLFDT(Z(2),Z(1)),D(6)=$$FMDIFF^XLFDT(Z(2),+X) 96 ....F Z=$S(IBTY="IN":7,1:3),10 I $$DL(Z,Z(2)) D 97 .....S Z1=$S(IBPOL1&(Z<10):Z_"I",1:Z),Z2=$S(Z<10:6,1:3) 98 .....S IBSEL1=IBSEL1_Z1_",",Y(Z1)=$S(IBRPT="D":$S(Z2=3:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 99 .....I Z1=Z,Z<10 S Z3=Z_"I",IBSEL1=IBSEL1_Z3_",",Y(Z3)=$S(IBRPT="D":$S(Z2=3:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 100 ...; 101 ...; - Date closed. 102 ...I Z(2) D 103 ....S D(4)=$$FMDIFF^XLFDT(Z(2),Z(1)),D(5)=$$FMDIFF^XLFDT(Z(2),+X) 104 ....F Z=$S(IBTY="IN":8,1:4),11 I $$DL(Z,Z(2)) D 105 .....S Z1=$S(IBPOL1&(Z<11):Z_"I",1:Z),Z2=$S(Z<11:5,1:4) 106 .....S IBSEL1=IBSEL1_Z1_",",Y(Z1)=$S(IBRPT="D":$S(Z2=4:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 107 .....I Z1=Z,Z<11 S Z3=Z_"I",IBSEL1=IBSEL1_Z3_",",Y(Z3)=$S(IBRPT="D":$S(Z2=4:Z(1),1:+X)_U_Z(2)_U_D(Z2),1:D(Z2)) 108 ..; 109 ..; - Save data for detail or summary report(s). 110 ..F Y=1:1 S Z=$P(IBSEL1,",",Y) Q:'Z D 111 ...I IBRPT="D" D 112 ....S Y(Z)=$P(IBN0,U)_U_Y(Z)_U_$S(IBPOL1:"*",1:""),Y1(Z)=$G(Y1(Z))+1 113 ....S ^TMP("IBJDB1",$J,IBDIV,IBTY,Z,$P(IBDFN,U)_"@@"_$P(IBDFN,U,9),Y1(Z))=Y(Z) 114 ...E S IBCT(IBDIV,IBTY,Z)=IBCT(IBDIV,IBTY,Z)+1,IBTL(IBDIV,IBTY,Z)=IBTL(IBDIV,IBTY,Z)+Y(Z) 115 ; 116 Q 117 ; 118 INIT(X) ; - Initialize summary accumulators/detail division nodes. 119 I IBRPT="D" S ^TMP("IBJDB1",$J,X)="" Q 120 F Y=1:1:4,9,10,11,"2I","3I","4I" S (IBCT(X,"OP",Y),IBTL(X,"OP",Y))=0 121 F Y=5:1:11,"6I","7I","8I" S (IBCT(X,"IN",Y),IBTL(X,"IN",Y))=0 122 Q 123 ; 124 AUTH(IBN) ; - Is this an authorized claim? 125 ; Input: IBN=Pointer to the AR in file #430 126 ; Output: VAL=1^2^3^4^5, where: 127 ; 1=1-Authorized claim 128 ; 0-Not an authorized claim 129 ; 2=Date AR was authorized 130 ; 3=Date AR was activated 131 ; 4=AR first payment date 132 ; 5=Date AR was closed 133 ; 134 N IBPAY,IBT,IBT0,IBT1,VAL,X 135 S VAL=0 I '$G(IBN) G AUTHQ 136 ; 137 ; - Get date authorized (required). 138 S X=$P($G(^DGCR(399,IBN,"S")),U,10) G:'X AUTHQ S VAL="1^"_X 139 ; 140 ; - Get date activated, if available. 141 S X=$P($G(^PRCA(430,IBN,6)),U,21) I X S $P(VAL,U,3)=X\1 G FP 142 S X=$P($G(^PRCA(430,IBN,9)),U,3) I X S $P(VAL,U,3)=X\1 G FP 143 S X=$P($G(^PRCA(430,IBN,0)),U,10) I X S $P(VAL,U,3)=X\1 144 ; 145 FP ; - Get first payment date, if available. 146 I '$P($G(^PRCA(430,IBN,7)),U,7) G CL ; No payments made. 147 S (IBPAY,IBT)=0 F S IBT=$O(^PRCA(433,"C",IBN,IBT)) Q:'IBT D Q:IBPAY 148 .S IBT0=$G(^PRCA(433,IBT,0)),IBT1=$G(^(1)) 149 .I $P(IBT0,U,4)'=2 Q ; Not complete. 150 .I $P(IBT1,U,2)'=2,$P(IBT1,U,2)'=34 Q ; Not a payment. 151 .S X=$S(+IBT1:+IBT1,1:$P(IBT1,U,9)\1),$P(VAL,U,4)=X,IBPAY=1 152 ; 153 CL ; - Get date AR closed. 154 S X=$$CLO^PRCAFN(IBN) I X>0 S $P(VAL,U,5)=X 155 ; 156 ; - Is there a payment date AND a closed date for this claim? 157 I '$P(VAL,U,4),$P(VAL,U,5) S $P(VAL,U)=0 158 ; 159 AUTHQ Q VAL 160 ; 161 DL(X,X1) ; - Is line item date valid for report? 162 ; Input: X=Line item number (or 0), X1=Line item date 163 ; Output: 1=valid, 0=invalid 164 ; *Requires pre-defined variables IBBDT, IBEDT, and IBSEL 165 S X2=0 I 'X1 G DLQ 166 I 'X S:X1'<IBBDT&(X1'>IBEDT) X2=1 G DLQ 167 I IBSEL[(","_X_","),X1'<IBBDT,X1'>IBEDT S X2=1 168 DLQ Q X2
Note:
See TracChangeset
for help on using the changeset viewer.
