- 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/IBCEF21.m
r628 r636 1 1 IBCEF21 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS CONTINUED ;06-FEB-96 2 ;;2.0;INTEGRATED BILLING;**51,296,371,389**;21-MAR-94;Build 6 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;2.0;INTEGRATED BILLING;**51,296**;21-MAR-94 4 3 ; 5 4 COID(IBIFN) ; Claim office ID … … 40 39 D SET^IBCSC5B(IBIFN,.IBARRAY) 41 40 I $P($G(IBARRAY),U,2) D ;Prosthetics 42 . S Z0=0 F S Z0=$O(IBARRAY(Z0)) Q:Z0="" S Z1=0 F S Z1=$O(IBARRAY(Z0,Z1)) Q:'Z1 S Z=Z+1,IBXDATA(Z)="Prosthetic: "_$E($ $PINB^IBCSC5B(+IBARRAY(Z0,Z1)),1,39)_" "_$E(Z0,4,5)_"/"_$E(Z0,6,7)_"/"_$E(Z0,1,2)41 . S Z0=0 F S Z0=$O(IBARRAY(Z0)) Q:Z0="" S Z1=0 F S Z1=$O(IBARRAY(Z0,Z1)) Q:'Z1 S Z=Z+1,IBXDATA(Z)="Prosthetic: "_$E($P($$PIN^IBCSC5B(Z1),U,2),1,39)_" "_$E(Z0,4,5)_"/"_$E(Z0,6,7)_"/"_$E(Z0,1,2) 43 42 Q 44 43 ; … … 78 77 Q 79 78 ; 80 INSSECID(IBIFN,TYPE,SEQ) ; Extract subscriber and patient prim/sec ID's81 ; IBIFN required82 ; TYPE is either "PAT" or "SUB" to indicate we need to extract either83 ; patient or subscriber ID information. Default="SUB".84 ; SEQ is the insurance sequence# (1,2,3). Default is current ins seq#.85 ;86 ; Output:87 ; Function returns an 8-piece string as follows.88 ; [1] primary qualifier89 ; [2] primary ID90 ; [3] secondary qual(1)91 ; [4] secondary ID(1)92 ; [5] secondary qual(2)93 ; [6] secondary ID(2)94 ; [7] secondary qual(3)95 ; [8] secondary ID(3)96 ;97 NEW DATA,DFN,POL,IB0,IB5,REL98 S DATA=""99 S IBIFN=+$G(IBIFN) I 'IBIFN G INSSX100 I $G(TYPE)="" S TYPE="SUB" ; default type of ID's to get101 I '$F(".PAT.SUB.","."_TYPE_".") G INSSX102 I '$G(SEQ) S SEQ=$$COBN^IBCEF(IBIFN) ; default current ins seq#103 I '$F(".1.2.3.","."_SEQ_".") G INSSX104 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) I 'DFN G INSSX105 S POL=+$P($G(^DGCR(399,IBIFN,"M")),U,SEQ+11) I 'POL G INSSX106 S IB0=$G(^DPT(DFN,.312,POL,0)) I IB0="" G INSSX107 S IB5=$G(^DPT(DFN,.312,POL,5))108 S REL=+$P(IB0,U,16) ; pat rel to insured109 S $P(DATA,U,1)="MI"110 S $P(DATA,U,2)=$P(IB0,U,2) ; subscriber primary ID111 S $P(DATA,U,3,8)=$P(IB5,U,2,7) ; subscriber secondary data112 I TYPE="PAT",REL'=1 D113 . S $P(DATA,U,2)=$P(IB5,U,1) ; patient primary ID114 . S $P(DATA,U,3,8)=$P(IB5,U,8,13) ; patient secondary data115 . Q116 ;117 S DATA=$$SCRUB(DATA) ; scrub the data118 INSSX ;119 Q DATA120 ;121 SCRUB(DATA) ; Scrub the 8-piece string gathered above122 NEW PCE123 ;124 ; make sure you can't have an ID without a qualifier or a qualifier125 ; without an ID. Check all 4 pairs.126 F PCE=1,3,5,7 D127 . I $P(DATA,U,PCE)'="",$P(DATA,U,PCE+1)'="" Q128 . S ($P(DATA,U,PCE),$P(DATA,U,PCE+1))=""129 . Q130 ;131 ; fill in secondary gaps. If Set1 and Set2 are blank, but Set3 exists132 ; then move Set3 to Set1 and delete Set3.133 I $P(DATA,U,3)="",$P(DATA,U,5)="",$P(DATA,U,7)'="" D134 . S $P(DATA,U,3)=$P(DATA,U,7),$P(DATA,U,4)=$P(DATA,U,8)135 . S ($P(DATA,U,7),$P(DATA,U,8))=""136 . Q137 ;138 ; fill in secondary gaps more generically.139 ; If Set(n) is blank, but Set(n+1) exists, then move it up.140 F PCE=3,5 D141 . I $P(DATA,U,PCE)="",$P(DATA,U,PCE+2)'="" D142 .. S $P(DATA,U,PCE)=$P(DATA,U,PCE+2)143 .. S $P(DATA,U,PCE+1)=$P(DATA,U,PCE+3)144 .. S ($P(DATA,U,PCE+2),$P(DATA,U,PCE+3))=""145 .. Q146 . Q147 ;148 Q DATA149 ;
Note:
See TracChangeset
for help on using the changeset viewer.