Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCCC1

IBCCC1.m

Go to the documentation of this file.
  1. IBCCC1 ;ALB/AAS - CANCEL AND CLONE A BILL - CONTINUED ;25-JAN-90
  1. ;;2.0;INTEGRATED BILLING;**80,109,106,51,320,358,433,432,547,714**;21-MAR-94;Build 8
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRCC1
  1. ;
  1. ;STEP 1 - cancel bill
  1. ;STEP 1.5 - entry to clone previously cancelled bill. (must be cancell)
  1. ;STEP 2 - build array of IBIDS call screen that asks ok
  1. ;STEP 3 - pass stub entry to ar
  1. ;STEP 4 - store stub data in MCCR then x-ref
  1. ;STEP 4.5 - store claim clone info on "S1" node.
  1. ;STEP 5 - get remainder of data to move and store in MCCR then x-ref
  1. ;STEP 6 - go to screens, come out to IBB1 or something like that
  1. ;
  1. STEP4 S X=$P($T(WHERE+1),";;",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)
  1. ;S X=$P($T(WHERE1),";;",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,U,1)),U,$P(X1,U,2))=IBIDS(I) ; IB*2.0*714
  1. ;WCJ;IB*2.0*547;added M2
  1. ;S IBIFN=PRCASV("ARREC") F I=0,"C","M","M1","S","U","U1" I $D(IBDR(I)) S ^DGCR(399,IBIFN,I)=IBDR(I)
  1. S IBIFN=PRCASV("ARREC") F I=0,"C","M","M1","M2","S","U","U1" I $D(IBDR(I)) S ^DGCR(399,IBIFN,I)=IBDR(I)
  1. D ; Protect variables;index entry;replace FT if copy/clone and it chngs
  1. . N IBHOLD,DIE,DR,DA,X,Y
  1. . S IBHOLD("FT")=$P($G(^DGCR(399,IBIFN,0)),U,19)
  1. . S $P(^DGCR(399,0),"^",3)=IBIFN,$P(^(0),"^",4)=$P(^(0),"^",4)+1 W:$G(IBSILENT)="" !,"Cross-referencing new billing entry..." D INDEX^IBCCC2
  1. .; 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
  1. . I $G(IBCNCOPY)!$G(IBCNCRD),IBHOLD("FT"),IBHOLD("FT")'=$P($G(^DGCR(399,IBIFN,0)),U,19) S DA=IBIFN,DIE="^DGCR(399,",DR=".19////"_IBHOLD("FT") D ^DIE
  1. S IBYN=1 W:$G(IBSILENT)="" !!,*7,"Billing Record #",$P(^DGCR(399,+IBIFN,0),"^",1)," established for '",VADM(1),"'..."
  1. S:$G(IBCE("EDI")) IBCE("EDI","NEW")=IBIFN
  1. I $G(IBCE("EDI"))!($G(IBCTCOPY)=1) S IBHV("IBIFN1")=IBIFN ; New bill #
  1. S IBBCT=IBIFN ;bill the old claim was cloned TO.
  1. END K %,%DT,IB,IBA,IBNWBL,IBBT,IBIDS,I,J,VADM,X,X1,X2,X3,X4,Y
  1. ;
  1. STEP4P5 ;added in patch 320
  1. ;first, put the TO data on the FROM bill
  1. ; Skip if not a CLON or CRD claim
  1. ;
  1. I '$G(IBCNCOPY)&('$G(IBCNCRD)) G STEP45X
  1. S DIE="^DGCR(399,",DA=IBBCF,DR="29////"_$G(IBBCT) D ^DIE
  1. S DIE="^DGCR(399,",DA=IBBCF,DR="31////"_$G(IBDBC) D ^DIE
  1. S DIE="^DGCR(399,",DA=IBBCF,DR="32////"_$G(IBBCB) D ^DIE
  1. ;
  1. ; esg - 8/23/06 - IB*2*358 - fix semi-colon in free text field
  1. S DIE="^DGCR(399,",DA=IBBCF,DR="33////^S X=$G(IBCCR)" D ^DIE
  1. ;
  1. ;now, put the FROM data on the TO bill
  1. ;
  1. S DIE="^DGCR(399,",DA=IBBCT,DR="30////"_$G(IBBCF) D ^DIE
  1. ;
  1. STEP45X G ^IBCCC2 ;go to step 5
  1. ;
  1. 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)
  1. Q
  1. ; NOTE: any new or changed data nodes MAY need to be updated in IBNCPDP5
  1. WHERE ;
  1. ;;.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;.28^0^28;151^U^1;152^U^2;155^U^5;159.5^U^20;
  1. ;