source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCCC1.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1IBCCC1 ;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 ;
16STEP4 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.
27END K %,%DT,IB,IBA,IBNWBL,IBBT,IBIDS,I,J,VADM,X,X1,X2,X3,X4,Y
28 ;
29STEP4P5 ;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 ;
44STEP45X G ^IBCCC2 ;go to step 5
45 ;
46 ;
47XREF 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 ;
50WHERE ;;.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 ;
Note: See TracBrowser for help on using the repository browser.