- 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 Feb 18, 2025@23:35:28 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 ;