| 1 | IBCNSCD3 ;ALB/CPM - DELETE INSURANCE COMPANY (CON'T) ; 11-MAY-95
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**28,46**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | MERGE ; Determine whether company information must be merged to another.
|
|---|
| 6 | ; Required variable input:
|
|---|
| 7 | ; IBCNS -- Pointer to the company in file #36
|
|---|
| 8 | ;
|
|---|
| 9 | ; Variable output:
|
|---|
| 10 | ; IBCALLAR -- Set to 1 if billing activity must be re-pointed
|
|---|
| 11 | ; IBCALLIR -- Set to 1 if Insurance reviews must be re-pointed
|
|---|
| 12 | ; IBREP -- Pointer to a company in file #36, or 0
|
|---|
| 13 | ; IBREPN -- May be set to an insurance company name
|
|---|
| 14 | ; IBQUIT -- Set to 1 if the user wants to quit the option
|
|---|
| 15 | ;
|
|---|
| 16 | N IBAR,IBMERGE,IBCNSRD,IBCNSRD1
|
|---|
| 17 | W !!,$TR($J("",80)," ","="),!
|
|---|
| 18 | S (IBCALLAR,IBCALLIR,IBMERGE,IBREP,IBQUIT)=0
|
|---|
| 19 | ;
|
|---|
| 20 | ; - check AR to see if the company is filed as a debtor
|
|---|
| 21 | S IBAR=+$$DEL^RCAMINS(IBCNS)
|
|---|
| 22 | I 'IBAR W !?3,">> This company is not established as a debtor in Accounts Receivable.",!
|
|---|
| 23 | I IBAR=1 W !?3,">> There is a debtor, but no bills, for this company in Accounts Receivable.",!
|
|---|
| 24 | I IBAR=2 S (IBCALLAR,IBMERGE)=1 W !?3,">> There is billing activity associated with this company!",!
|
|---|
| 25 | ;
|
|---|
| 26 | ; - see if there are Insurance Reviews for the company
|
|---|
| 27 | I $D(^IBT(356.2,"AIACT",IBCNS)) S (IBCALLIR,IBMERGE)=1 W !?3,">> There are known Insurance Reviews associated with this company.",!
|
|---|
| 28 | ;
|
|---|
| 29 | I 'IBMERGE W !,"** This company may be deleted from your system without merging. **" G MERGEQ
|
|---|
| 30 | ;
|
|---|
| 31 | ; - select another company to merge information into
|
|---|
| 32 | W !!,"You must merge the information from this company into another company!",!
|
|---|
| 33 | S IBCNSRD=$P($G(^DIC(36,IBCNS,0)),"^",16)
|
|---|
| 34 | I IBCNSRD,$G(^DIC(36,IBCNSRD,0))]"" S IBCNSRD=$G(^(0)),IBCNSRD1=$G(^(.11)) D
|
|---|
| 35 | .W !?2,"Please note that insurance policy and plan information was repointed to:"
|
|---|
| 36 | .W !?6,$P(IBCNSRD,"^")," (",$S($P(IBCNSRD,"^",5):"Ina",1:"A"),"ctive Company)"
|
|---|
| 37 | .I $P(IBCNSRD1,"^")]"" W !?6,$P(IBCNSRD1,"^")
|
|---|
| 38 | .I $P(IBCNSRD1,"^",2)]"" W !?6,$P(IBCNSRD1,"^",2)
|
|---|
| 39 | .I $P(IBCNSRD1,"^",3)]"" W !?6,$P(IBCNSRD1,"^",3)
|
|---|
| 40 | .I $P(IBCNSRD1,"^",4)]"" W !?6,$P(IBCNSRD1,"^",4)," ",$P($G(^DIC(5,+$P(IBCNSRD1,"^",5),0)),"^",2)," ",$E($P(IBCNSRD1,"^",6),1,5),$S($E($P(IBCNSRD1,"^",6),6,9)]"":"-"_$E($P(IBCNSRD1,"^",6),6,9),1:"")
|
|---|
| 41 | ;
|
|---|
| 42 | S DIC(0)="QEAMZ",DIC="^DIC(36,",DIC("A")="Select Company to Merge Information: ",DIC("S")="I +Y'=IBCNS,'$G(^(5))",DIC("W")="D ID^IBCNSCD3"
|
|---|
| 43 | W ! D ^DIC K DIC S IBREP=+Y I Y<0 S IBQUIT=1 W !!,"No 'merge' company selected!" G MERGEQ
|
|---|
| 44 | I IBCALLAR,$$DEL^RCAMINS(IBREP)<1 W !!,"This company is not established as a debtor in Accounts Receivable!",!,"It will be established as a debtor prior to merging the billing activity."
|
|---|
| 45 | S IBREPN=Y(0,0)
|
|---|
| 46 | MERGEQ Q
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | INTRO ; Introductory text.
|
|---|
| 50 | W !!,"This action is designed to allow the deletion of Insurance companies"
|
|---|
| 51 | W !,"which meet one of the following criteria:"
|
|---|
| 52 | W !!," o The company was entered by error, and there is little or no insurance"
|
|---|
| 53 | W !," or billing activity associated with the company."
|
|---|
| 54 | W !!," o The company is really the same company as another entry in your file"
|
|---|
| 55 | W !," and you wish to merge all activity for the company to the other entry."
|
|---|
| 56 | W !!,"It is not necessary, nor desirable, to delete every company which is inactive."
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | WARN ; Describe how the delete/merge will work.
|
|---|
| 60 | W !!,$TR($J("",70)," ","*")
|
|---|
| 61 | W !,"There may be entries in various files which point to ",$P(IBCNSD,"^")
|
|---|
| 62 | W !,"which are not immediately obvious. ",$S(IBREP:"Merg",1:"Delet"),"ing this company"
|
|---|
| 63 | W !,"will cause a background job to be queued later in the day which will"
|
|---|
| 64 | W !,"find all such entries and delete or merge these pointers as necessary."
|
|---|
| 65 | W !!,"You will receive a mail message from the system when this job is complete."
|
|---|
| 66 | W !,"Please note that there is a potential problem where pointers will be"
|
|---|
| 67 | W !,"deleted when there is no company into which the pointed fields may be"
|
|---|
| 68 | W !,"merged. The mail message will indicate which records those are so they"
|
|---|
| 69 | W !,"may be reviewed.",!,$TR($J("",70)," ","*")
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | HLP ; Reader help for deleting companies
|
|---|
| 73 | I 'IBREP W !!,"If you wish to delete this company, enter 'YES.' Otherwise, enter 'NO.'" Q
|
|---|
| 74 | W !!,"If you enter 'YES,' all information pertaining to ",$P(IBCNSD,"^")
|
|---|
| 75 | W !,"will be repointed to ",IBREPN,". ",$P(IBCNSD,"^")
|
|---|
| 76 | W !,"will then be flagged for deletion from your system."
|
|---|
| 77 | W !!,"If you do not want this action to occur, enter 'NO.'"
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | ID ; Display the company identifer.
|
|---|
| 81 | N IB
|
|---|
| 82 | W:$D(^(.11)) " ",$P(^(.11),U,1)," ",$P(^(.11),U,4)
|
|---|
| 83 | S IB=Y,Y=$S('$D(^(.11)):"",$D(^DIC(5,+$P(^(.11),U,5),0))#2:$P(^(0),U,1),1:""),C=$P(^DD(5,.01,0),U,2) D Y^DIQ:Y]"" W " ",Y,@("$E("_DIC_"IB,0),0)") S Y=IB
|
|---|
| 84 | W:$D(^(0)) " ",$P(^(0),U,2)
|
|---|
| 85 | W " (ien: ",+Y,")"
|
|---|
| 86 | Q
|
|---|
