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