| [613] | 1 | IBCCC1 ;ALB/AAS - CANCEL AND CLONE A BILL - CONTINUED ;25-JAN-90
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**80,109,106,51,320,358**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRCC1
|
|---|
| 6 | ;
|
|---|
| 7 | ;STEP 1 - cancel bill
|
|---|
| 8 | ;STEP 1.5 - entry to clone previously cancelled bill. (must be cancell)
|
|---|
| 9 | ;STEP 2 - build array of IBIDS call screen that asks ok
|
|---|
| 10 | ;STEP 3 - pass stub entry to ar
|
|---|
| 11 | ;STEP 4 - store stub data in MCCR then x-ref
|
|---|
| 12 | ;STEP 4.5 - store claim clone info on "S1" node.
|
|---|
| 13 | ;STEP 5 - get remainder of data to move and store in MCCR then x-ref
|
|---|
| 14 | ;STEP 6 - go to screens, come out to IBB1 or something like that
|
|---|
| 15 | ;
|
|---|
| 16 | STEP4 S X=$P($T(WHERE),";;",2) F I=0:0 S I=$O(IBIDS(I)) Q:'I S X1=$P($E(X,$F(X,I)+1,999),";",1),$P(IBDR($P(X1,"^",1)),"^",$P(X1,"^",2))=IBIDS(I)
|
|---|
| 17 | S IBIFN=PRCASV("ARREC") F I=0,"C","M","M1","S","U","U1" I $D(IBDR(I)) S ^DGCR(399,IBIFN,I)=IBDR(I)
|
|---|
| 18 | D ; Protect variables;index entry;replace FT if copy/clone and it chngs
|
|---|
| 19 | . N IBHOLD,DIE,DR,DA,X,Y
|
|---|
| 20 | . S IBHOLD("FT")=$P($G(^DGCR(399,IBIFN,0)),U,19)
|
|---|
| 21 | . S $P(^DGCR(399,0),"^",3)=IBIFN,$P(^(0),"^",4)=$P(^(0),"^",4)+1 W !,"Cross-referencing new billing entry..." D INDEX^IBCCC2
|
|---|
| 22 | . I $G(IBCNCOPY),IBHOLD("FT"),IBHOLD("FT")'=$P($G(^DGCR(399,IBIFN,0)),U,19) S DA=IBIFN,DIE="^DGCR(399,",DR=".19////"_IBHOLD("FT") D ^DIE
|
|---|
| 23 | S IBYN=1 W !!,*7,"Billing Record #",$P(^DGCR(399,+IBIFN,0),"^",1)," established for '",VADM(1),"'..."
|
|---|
| 24 | S:$G(IBCE("EDI")) IBCE("EDI","NEW")=IBIFN
|
|---|
| 25 | I $G(IBCE("EDI"))!($G(IBCTCOPY)=1) S IBHV("IBIFN1")=IBIFN ; New bill #
|
|---|
| 26 | S IBBCT=IBIFN ;bill the old claim was cloned TO.
|
|---|
| 27 | END K %,%DT,IB,IBA,IBNWBL,IBBT,IBIDS,I,J,VADM,X,X1,X2,X3,X4,Y
|
|---|
| 28 | ;
|
|---|
| 29 | STEP4P5 ;added in patch 320
|
|---|
| 30 | ;first, put the TO data on the FROM bill
|
|---|
| 31 | ;
|
|---|
| 32 | I '$G(IBCNCOPY) G STEP45X
|
|---|
| 33 | S DIE="^DGCR(399,",DA=IBBCF,DR="29////"_$G(IBBCT) D ^DIE
|
|---|
| 34 | S DIE="^DGCR(399,",DA=IBBCF,DR="31////"_$G(IBDBC) D ^DIE
|
|---|
| 35 | S DIE="^DGCR(399,",DA=IBBCF,DR="32////"_$G(IBBCB) D ^DIE
|
|---|
| 36 | ;
|
|---|
| 37 | ; esg - 8/23/06 - IB*2*358 - fix semi-colon in free text field
|
|---|
| 38 | S DIE="^DGCR(399,",DA=IBBCF,DR="33////^S X=$G(IBCCR)" D ^DIE
|
|---|
| 39 | ;
|
|---|
| 40 | ;now, put the FROM data on the TO bill
|
|---|
| 41 | ;
|
|---|
| 42 | S DIE="^DGCR(399,",DA=IBBCT,DR="30////"_$G(IBBCF) D ^DIE
|
|---|
| 43 | ;
|
|---|
| 44 | STEP45X G ^IBCCC2 ;go to step 5
|
|---|
| 45 | ;
|
|---|
| 46 | ;
|
|---|
| 47 | XREF F IBI1=0:0 S IBI1=$O(^DD(399,IBI,1,IBI1)) Q:'IBI1 I $D(^DD(399,IBI,1,IBI1,1)) S DA=IBIFN,X=IBIDS(IBI) I X]"" X ^DD(399,IBI,1,IBI1,1)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | WHERE ;;.01^0^1;.02^0^2;.03^0^3;.04^0^4;.05^0^5;.06^0^6;.07^0^7;.08^0^8;.09^0^9;.11^0^11;.12^0^12;.17^0^17;.18^0^18;.19^0^19;.15^0^15;.16^0^16;.21^0^21;.22^0^22;.23^0^23;.24^0^24;.25^0^25;.26^0^26;.27^0^27;151^U^1;152^U^2;155^U^5;159.5^U^20;
|
|---|
| 51 | ;
|
|---|
