- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCU4.m
r613 r623 1 IBCU4 ;ALB/AAS - BILLING UTILITY ROUTINE (CONTINUED) ;12-FEB-90 2 ;;2.0;INTEGRATED BILLING;**109,122,137,245,349,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;MAP TO DGCRU4 6 ; 7 DDAT ;Input transform for Statement Covers From field 8 I '$D(DA) G TO 9 S IB00=+$P(^DGCR(399,+DA,0),"^",3) I +X<$P(IB00,".",1) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X G DDAT4 10 I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4 11 D PROCDT 12 I DGPRDTB,X>DGPRDTB K X W !?4,"Can't be greater than date of specified Procedures!",*7 G DDAT4 13 G DDAT4 14 DDAT1 ;Input transform for Statement covers to 15 I '$D(DA) G FROM 16 S IB00=$S($D(^DGCR(399,+DA,"U")):$P(^("U"),"^",1),1:"") I 'IB00 W !?4,"'Start Date' must be specified first!",*7 K X G DDAT4 17 I +X>DT W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4 18 I +X<IB00 W !?4,"Cannot preceed the 'Start Date'!",*7 K X G DDAT4 19 ;I $S($E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4 20 ;I $$FY(+IB00)'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4 21 ;I $E(IB00,1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 G DDAT4 22 D PROCDT 23 I DGPRDTE,X<DGPRDTE K X W !?4,"Can't be less than date of specified Procedures!",*7 G DDAT4 24 G DDAT4 25 ; 26 ;DDAT2 ;Input transform for OP VISITS DATE(S) field REPLACED WITH IBCU41 6/15/93 27 ;S IB00=$G(^DGCR(399,IBIFN,"U")) I $P(IB00,"^",1)']"" W !?4,*7,"No 'Start Date' on file...can't enter OP visit dates..." K X G DDAT4 28 ;I $P(IB00,"^",2)']"" W !?4,*7,"No 'End Date' on file...can't enter OP visit dates..." K X G DDAT4 29 ;I X<$P(IB00,"^",1) W !?4,*7,"Can't enter a visit date prior to 'Start Date'..." K X G DDAT4 30 ;I X>$P(IB00,"^",2) W !?4,*7,"Can't enter a visit date later than 'End Date'..." K X G DDAT4 31 ;I $P(^DGCR(399,IBIFN,0),"^",19)'=2,$D(^DGCR(399,"ASC2",IBIFN)),$O(^DGCR(399,IBIFN,"OP",0)) W !?4,*7,"Only 1 visit date allowed on bills with Amb. Surg. Codes!" K X G DDAT4 32 ;D APPT^IBCU3,DUPCHK^IBCU3 33 G DDAT4 34 ; 35 DDAT3 ; - x-ref call for to and from dates, REPLACED BY TRIGGERS ON .08, 151, 152 ON 10/18/93 36 ;if inpatient bill return DGNEWLOS to cause recalc of los in IBSC6 37 G DDAT4:'$D(X) 38 I $D(^DGCR(399,DA,0)),$P(^(0),"^",5)<3 S DGNEWLOS=1 39 S IB00=$S($D(^DGCR(399,+DA,"U")):^("U"),1:"") I IB00']"" K X G DDAT4 40 S IB02=$S(+$E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1),IB01=$E(IB00,1)_IB02_"0930",$P(^DGCR(399,DA,"U1"),"^",9)=IB02 ;,$P(^DGCR(399,DA,"U1"),"^",11)=$S($P(IB00,"^",2)>IB01:IB02+1,1:"") 41 ;I $P(^DGCR(399,DA,"U1"),"^",11)="" S $P(^("U1"),"^",12)="" 42 ; 43 DDAT4 K IB00,IB01,IB02,IB03,DGX,DGNOAP,DGJ,DGPROC,DGPRDT,DGPRDTE,DGPRDTB Q 44 ; 45 OTDAT ; Input transform for Other Care Start Date (399,48,.02) 46 I ('$G(DA(1)))!('$G(X)) Q 47 N IBX S IBX=$G(^DGCR(399,DA(1),"U")) 48 I +X<+IBX W !,?4,"Can Not Precede Bill Start Date!",!,*7 K X Q 49 I +X>+$P(IBX,U,2) W !,?4,"Can not be after Bill End Date!",!,*7 K X Q 50 Q 51 ; 52 CHDAT ; Input transform for chiropractics-related dates (399/245,246,247) 53 ; Make sure that date entered is not after end date of the bill 54 Q:'$D(X) 55 N IBX,Y 56 S IBX=$P($G(^DGCR(399,+DA,"U")),U,2) 57 I IBX="" W !?4,*7,"No end date of the bill on file - can't enter chiropractics-related dates " K X Q 58 I X>+IBX S Y=IBX D DD^%DT W !,?4,*7,"This date can not be after the end date of the claim ("_Y_") " K X Q 59 Q 60 ; 61 TO ;151 pseudo input x-form 62 I +X_.9<IBIDS(.03) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X Q 63 I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X 64 Q 65 FROM ;152 pseudo input x-form 66 I '$D(IBIDS(151)) W !?4,"'Start Date' must be specified first!",*7 K X Q 67 I +X<IBIDS(151) W !?4,"Cannot preceed the 'Start Date'!",*7 K X Q 68 ;I $S($E(IBIDS(151),4,5)<10:$E(IBIDS(151),2,3),1:$E(IBIDS(151),2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 Q 69 ;I $$FY(IBIDS(151))'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 Q 70 ;I $E(IBIDS(151),1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 Q 71 Q 72 ; 73 FY(DATE) ; return a dates Fiscal Year 74 N IBYR,IBFY S IBFY="" 75 I $G(DATE)?7N.E S IBYR=$S($E(DATE,4,5)<10:$E(DATE,1,3),1:$E(DATE,1,3)+1),IBFY=$E(IBYR,2,3) 76 Q IBFY 77 ; 78 SPEC ; - calculate discharge specialty 79 ; - input IBids(.08) = ptf record number 80 ; - output IBids(161) = pointer to billing specialty in 399.1 81 K IBIDS(161) 82 Q:$S('$D(IBIDS(.08)):1,'$D(^DGPT(+IBIDS(.08),70)):1,'$P(^(70),"^",2):1,'$D(^DIC(42.4,+$P(^(70),"^",2),0)):1,1:0) S IBIDS(161)=$P(^DGPT(IBIDS(.08),70),"^",2) 83 S IBIDS(161)=$P($G(^DIC(42.4,+IBIDS(161),0)),"^",5) I IBIDS(161)="" K IBIDS(161) Q 84 S IBIDS(161)=$O(^DGCR(399.1,"B",IBIDS(161),0)) 85 I '$D(^DGCR(399.1,+IBIDS(161),0)) K IBIDS(161) 86 Q 87 ; 88 PROCDT ; - find first and last dates of procedures 89 ; can't set from and to date inside of this range 90 S (DGPRDT,DGPROC,DGPRDTE,DGPRDTB)=0 91 F S DGPROC=$O(^DGCR(399,+DA,"CP",DGPROC)) Q:'DGPROC S DGPRDT=$P($G(^DGCR(399,+DA,"CP",DGPROC,0)),"^",2) D 92 . I DGPRDTB=0!(DGPRDTB>DGPRDT) S DGPRDTB=DGPRDT 93 . I DGPRDTE=0!(DGPRDTE<DGPRDT) S DGPRDTE=DGPRDT 94 . Q 95 Q 96 ; 97 TOBIN(Y,DA) ; Screen for UB-04 bill classification based on UB-04 location of care 98 ; Y = internal value of code for field .25 (UB-04 BILL CLASSIFICATION) 99 ; DA = bill ien in file 399 100 N IB0 101 S IB0=$P($G(^DGCR(399,DA,0)),U,24) ; Get UB-04 LOCATION OF CARE value 102 Q $S('IB0:0,(","_$P($G(^DGCR(399.1,+Y,0)),U,24)_",")'[(","_IB0_","):0,1:1) 103 ; 104 TRIG05(X,D0) ; Trigger executed on field .05 of file 399 to set field .25 105 ; Find the correct entry in file 399.1 that corresponds to the value in .05 106 ; X = value of field .05, location of care 107 ; D0 = IEN of bill entry in file 399 108 N Z,Z0,IEN,LOC 109 S LOC=$P($G(^DGCR(399,D0,0)),U,4) 110 S IEN="",Z=0 111 I LOC'="" F S Z=$O(^DGCR(399.1,"C",X,Z)) Q:'Z S Z0=$P($G(^DGCR(399.1,Z,0)),U,23,24) I +Z0,(","_$P(Z0,U,2)_",")[(","_LOC_",") S IEN=Z Q 112 Q IEN 113 ; 114 TOB(IBIFN,POS) ;Function returns the 3 digit type of bill from UB-04 115 ; fields or the position (1-3) as determined by POS (optional) 116 N Z 117 S Z=$P($G(^DGCR(399,IBIFN,0)),U,24,26),Z=$P(Z,U)_$P($G(^DGCR(399.1,+$P(Z,U,2),0)),U,2)_$P(Z,U,3) 118 Q $S('$G(POS):Z,1:$E(Z,+POS)) 119 ; 1 IBCU4 ;ALB/AAS - BILLING UTILITY ROUTINE (CONTINUED) ; 12-FEB-90 2 ;;2.0;INTEGRATED BILLING;**109,122,137,245,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;MAP TO DGCRU4 6 ; 7 DDAT ;Input transform for Statement Covers From field 8 I '$D(DA) G TO 9 S IB00=+$P(^DGCR(399,+DA,0),"^",3) I +X<$P(IB00,".",1) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X G DDAT4 10 I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4 11 D PROCDT 12 I DGPRDTB,X>DGPRDTB K X W !?4,"Can't be greater than date of specified Procedures!",*7 G DDAT4 13 G DDAT4 14 DDAT1 ;Input transform for Statement covers to 15 I '$D(DA) G FROM 16 S IB00=$S($D(^DGCR(399,+DA,"U")):$P(^("U"),"^",1),1:"") I 'IB00 W !?4,"'Start Date' must be specified first!",*7 K X G DDAT4 17 I +X>DT W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4 18 I +X<IB00 W !?4,"Cannot preceed the 'Start Date'!",*7 K X G DDAT4 19 ;I $S($E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4 20 ;I $$FY(+IB00)'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4 21 ;I $E(IB00,1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 G DDAT4 22 D PROCDT 23 I DGPRDTE,X<DGPRDTE K X W !?4,"Can't be less than date of specified Procedures!",*7 G DDAT4 24 G DDAT4 25 ; 26 ;DDAT2 ;Input transform for OP VISITS DATE(S) field REPLACED WITH IBCU41 6/15/93 27 ;S IB00=$G(^DGCR(399,IBIFN,"U")) I $P(IB00,"^",1)']"" W !?4,*7,"No 'Start Date' on file...can't enter OP visit dates..." K X G DDAT4 28 ;I $P(IB00,"^",2)']"" W !?4,*7,"No 'End Date' on file...can't enter OP visit dates..." K X G DDAT4 29 ;I X<$P(IB00,"^",1) W !?4,*7,"Can't enter a visit date prior to 'Start Date'..." K X G DDAT4 30 ;I X>$P(IB00,"^",2) W !?4,*7,"Can't enter a visit date later than 'End Date'..." K X G DDAT4 31 ;I $P(^DGCR(399,IBIFN,0),"^",19)'=2,$D(^DGCR(399,"ASC2",IBIFN)),$O(^DGCR(399,IBIFN,"OP",0)) W !?4,*7,"Only 1 visit date allowed on bills with Amb. Surg. Codes!" K X G DDAT4 32 ;D APPT^IBCU3,DUPCHK^IBCU3 33 G DDAT4 34 ; 35 DDAT3 ; - x-ref call for to and from dates, REPLACED BY TRIGGERS ON .08, 151, 152 ON 10/18/93 36 ;if inpatient bill return DGNEWLOS to cause recalc of los in IBSC6 37 G DDAT4:'$D(X) 38 I $D(^DGCR(399,DA,0)),$P(^(0),"^",5)<3 S DGNEWLOS=1 39 S IB00=$S($D(^DGCR(399,+DA,"U")):^("U"),1:"") I IB00']"" K X G DDAT4 40 S IB02=$S(+$E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1),IB01=$E(IB00,1)_IB02_"0930",$P(^DGCR(399,DA,"U1"),"^",9)=IB02 ;,$P(^DGCR(399,DA,"U1"),"^",11)=$S($P(IB00,"^",2)>IB01:IB02+1,1:"") 41 ;I $P(^DGCR(399,DA,"U1"),"^",11)="" S $P(^("U1"),"^",12)="" 42 ; 43 DDAT4 K IB00,IB01,IB02,IB03,DGX,DGNOAP,DGJ,DGPROC,DGPRDT,DGPRDTE,DGPRDTB Q 44 ; 45 OTDAT ; Input transform for Other Care Start Date (399,48,.02) 46 I ('$G(DA(1)))!('$G(X)) Q 47 N IBX S IBX=$G(^DGCR(399,DA(1),"U")) 48 I +X<+IBX W !,?4,"Can Not Precede Bill Start Date!",!,*7 K X Q 49 I +X>+$P(IBX,U,2) W !,?4,"Can not be after Bill End Date!",!,*7 K X Q 50 Q 51 ; 52 ; 53 ; 54 TO ;151 pseudo input x-form 55 I +X_.9<IBIDS(.03) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X Q 56 I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X 57 Q 58 FROM ;152 pseudo input x-form 59 I '$D(IBIDS(151)) W !?4,"'Start Date' must be specified first!",*7 K X Q 60 I +X<IBIDS(151) W !?4,"Cannot preceed the 'Start Date'!",*7 K X Q 61 ;I $S($E(IBIDS(151),4,5)<10:$E(IBIDS(151),2,3),1:$E(IBIDS(151),2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 Q 62 ;I $$FY(IBIDS(151))'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 Q 63 ;I $E(IBIDS(151),1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 Q 64 Q 65 ; 66 FY(DATE) ; return a dates Fiscal Year 67 N IBYR,IBFY S IBFY="" 68 I $G(DATE)?7N.E S IBYR=$S($E(DATE,4,5)<10:$E(DATE,1,3),1:$E(DATE,1,3)+1),IBFY=$E(IBYR,2,3) 69 Q IBFY 70 ; 71 SPEC ; - calculate discharge specialty 72 ; - input IBids(.08) = ptf record number 73 ; - output IBids(161) = pointer to billing specialty in 399.1 74 K IBIDS(161) 75 Q:$S('$D(IBIDS(.08)):1,'$D(^DGPT(+IBIDS(.08),70)):1,'$P(^(70),"^",2):1,'$D(^DIC(42.4,+$P(^(70),"^",2),0)):1,1:0) S IBIDS(161)=$P(^DGPT(IBIDS(.08),70),"^",2) 76 S IBIDS(161)=$P($G(^DIC(42.4,+IBIDS(161),0)),"^",5) I IBIDS(161)="" K IBIDS(161) Q 77 S IBIDS(161)=$O(^DGCR(399.1,"B",IBIDS(161),0)) 78 I '$D(^DGCR(399.1,+IBIDS(161),0)) K IBIDS(161) 79 Q 80 ; 81 PROCDT ; - find first and last dates of procedures 82 ; can't set from and to date inside of this range 83 S (DGPRDT,DGPROC,DGPRDTE,DGPRDTB)=0 84 F S DGPROC=$O(^DGCR(399,+DA,"CP",DGPROC)) Q:'DGPROC S DGPRDT=$P($G(^DGCR(399,+DA,"CP",DGPROC,0)),"^",2) D 85 . I DGPRDTB=0!(DGPRDTB>DGPRDT) S DGPRDTB=DGPRDT 86 . I DGPRDTE=0!(DGPRDTE<DGPRDT) S DGPRDTE=DGPRDT 87 . Q 88 Q 89 ; 90 TOBIN(Y,DA) ; Screen for UB-04 bill classification based on UB-04 location of care 91 ; Y = internal value of code for field .25 (UB-04 BILL CLASSIFICATION) 92 ; DA = bill ien in file 399 93 N IB0 94 S IB0=$P($G(^DGCR(399,DA,0)),U,24) ; Get UB-04 LOCATION OF CARE value 95 Q $S('IB0:0,(","_$P($G(^DGCR(399.1,+Y,0)),U,24)_",")'[(","_IB0_","):0,1:1) 96 ; 97 TRIG05(X,D0) ; Trigger executed on field .05 of file 399 to set field .25 98 ; Find the correct entry in file 399.1 that corresponds to the value in .05 99 ; X = value of field .05, location of care 100 ; D0 = IEN of bill entry in file 399 101 N Z,Z0,IEN,LOC 102 S LOC=$P($G(^DGCR(399,D0,0)),U,4) 103 S IEN="",Z=0 104 I LOC'="" F S Z=$O(^DGCR(399.1,"C",X,Z)) Q:'Z S Z0=$P($G(^DGCR(399.1,Z,0)),U,23,24) I +Z0,(","_$P(Z0,U,2)_",")[(","_LOC_",") S IEN=Z Q 105 Q IEN 106 ; 107 TOB(IBIFN,POS) ;Function returns the 3 digit type of bill from UB-04 108 ; fields or the position (1-3) as determined by POS (optional) 109 N Z 110 S Z=$P($G(^DGCR(399,IBIFN,0)),U,24,26),Z=$P(Z,U)_$P($G(^DGCR(399.1,+$P(Z,U,2),0)),U,2)_$P(Z,U,3) 111 Q $S('$G(POS):Z,1:$E(Z,+POS)) 112 ;
Note:
See TracChangeset
for help on using the changeset viewer.
