- 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/IBCBB5.m
r628 r636 1 1 IBCBB5 ;ALB/BGA - CONT OF MEDICARE EDIT CHECKS ;08/12/98 2 ;;2.0;INTEGRATED BILLING;**51,137 ,371**;21-MAR-94;Build 573 ;;Per VHA Directive 2004-038, this routine should not be modified.2 ;;2.0;INTEGRATED BILLING;**51,137**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified 4 4 ; 5 5 D F^IBCEF("N-ADMISSION DATE","IBZADMIT",,IBIFN) … … 15 15 S IBI=0 F S IBI=$O(IBXSAVE("OCCS",IBI)) Q:'IBI D 16 16 . N IBOCSDT,IBOCSDT1,Z 17 . S IBOCSDT=$P(IBXSAVE("OCCS",IBI),U,2),IBOCSDT1=$P(IBXSAVE("OCCS",IBI),U, 3),IBOCCS=$P(IBXSAVE("OCCS",IBI),U)17 . S IBOCSDT=$P(IBXSAVE("OCCS",IBI),U,2),IBOCSDT1=$P(IBXSAVE("OCCS",IBI),U,4),IBOCCS=$P(IBXSAVE("OCCS",IBI),U) 18 18 . S IBOCSP(IBOCCS,$O(IBOCSP(IBOCCS,""),-1)+1)=IBXSAVE("OCCS",IBI) 19 . ; Occurrence Code End dates must be > start date and are required for OCCURANCE SPANS20 . I 'IBOCSDT1 S IBER=IBER_"IB155;" Q21 . I IBOCSDT1<IBOCSDT S IBER=IBER_"IB150;" Q22 19 ; 23 20 S IBI=0 F S IBI=$O(IBXSAVE("OCC",IBI)) Q:'IBI D … … 37 34 S IBX=0 38 35 F S IBX=$O(IBXDATA(IBX)) Q:'IBX D Q:IBQUIT 39 . I '$D(IBVALCD($P(IBXDATA(IBX),U))) S IBVALCD($P(IBXDATA(IBX),U))=$P(IBXDATA(IBX),U,2)40 36 . ; value code 01 must have a value>0 41 . I $P(IBXDATA(IBX),U)="01",IBER'["134;",$P(IBXDATA(IBX),U,2)'>0 S IBQUIT=$$IBER^IBCBB3(.IBER,134) Q 37 . I $P(IBXDATA(IBX),U)="01",IBER'["134;",$P(IBXDATA(IBX),U,2)'>0 S IBQUIT=$$IBER^IBCBB3(.IBER,134) 38 . Q:IBQUIT 42 39 . ; value code 02 must have a value=0 43 . I $P(IBXDATA(IBX),U)="02",IBER'["135;",+$P(IBXDATA(IBX),U,2)'=0 S IBQUIT=$$IBER^IBCBB3(.IBER,135) Q40 . I $P(IBXDATA(IBX),U)="02",IBER'["135;",+$P(IBXDATA(IBX),U,2)'=0 S IBQUIT=$$IBER^IBCBB3(.IBER,135) 44 41 . ; code^amount^dollar amt flag (1=amt,0=quantity) 45 . I $P(IBXDATA(IBX),U,2)="",IBER'["157;" S IBQUIT=$$IBER^IBCBB3(.IBER,157) Q 46 . I '$$CHK^IBCVC($P(IBXDATA(IBX),U,4),$P(IBXDATA(IBX),U,2)),IBER'["158;" S IBQUIT=$$IBER^IBCBB3(.IBER,158) Q 42 . Q:IBQUIT 43 . I '$D(IBVALCD($P(IBXDATA(IBX),U))) S IBVALCD($P(IBXDATA(IBX),U))=$P(IBXDATA(IBX),U,2) Q 44 ; Must have value code 01 or 02 for TOB 11X, 18X, 21X - default it 45 ;I '$D(IBVALCD("01")),'$D(IBVALCD("02")),$S(IBTOB12="11":1,IBTOB12="18":1,1:IBTOB12="21") S IBQUIT=$$IBER^IBCBB3(.IBER,132) 47 46 ; 48 47 Q:IBQUIT
Note:
See TracChangeset
for help on using the changeset viewer.