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