| 1 | RCAMINS ;WASH-ISC@ALTOONA,PA/LDB-CHECK FOR INSURANCE COMPANY AS DEBTOR,SECONDARY OR TERTIARY CO ;8/17/95 1:27 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**6,20,144**;Mar 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | DEL(INS) ;Delete insurance company check
|
|---|
| 5 | N DEB,INS1,INSN1,INSN2
|
|---|
| 6 | I '$G(INS) S INS1="0^NO INSURANCE ENTRY" G DELQ
|
|---|
| 7 | S INS1=0,DEB=$O(^RCD(340,"B",INS_";DIC(36,",0))
|
|---|
| 8 | I 'DEB S INS1=0 G DELQ
|
|---|
| 9 | I $O(^PRCA(430,"C",DEB,0)) S INS1=2
|
|---|
| 10 | I '$O(^PRCA(430,"C",DEB,0)) S INS1=1
|
|---|
| 11 | DELQ Q INS1
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | EN(INS,INS1,INS2,ERROR) ;Repoint any bills with an obsolete insurance co.
|
|---|
| 15 | Q:'$G(INS)
|
|---|
| 16 | N ADD,BN,DEB,DIE,DIK,DR,ETYP,MSG,XMSUB
|
|---|
| 17 | S ERROR=""
|
|---|
| 18 | K ^TMP("RCAMINS",$J)
|
|---|
| 19 | S DEB(1)=$O(^RCD(340,"B",INS_";DIC(36,",0))
|
|---|
| 20 | I 'DEB(1),'$G(INS2) S ERROR="-1^NO AR DEBTOR ENTRY FOR 1ST INSURANCE CO. "_DEB(1) Q
|
|---|
| 21 | S:'$G(INS1) DEB(2)=""
|
|---|
| 22 | I $G(INS1),'$G(INS2) S DEB(2)=$O(^RCD(340,"B",INS1_";DIC(36,",0)) I 'DEB(2) D
|
|---|
| 23 | .K DD,DO S DIC="^RCD(340,",DIC(0)="QL",X=INS1_";DIC(36,",DLAYG0=340 D FILE^DICN K DIC,DD,DLAYGO,DO,X
|
|---|
| 24 | .S DEB(2)=+Y
|
|---|
| 25 | I '$G(INS2),DEB(2)=-1 S ERROR="-1^NO AR DEBTOR ENTRY FOR "_INS1 Q
|
|---|
| 26 | S:$G(INS) INSN1=$P($G(^DIC(36,+INS,0)),"^")
|
|---|
| 27 | S INSN2=$S($G(INS1):$P($G(^DIC(36,+INS1,0)),"^"),1:"")
|
|---|
| 28 | S ADD(1)=$$DADD^RCAMADD(INS_";DIC(36,")
|
|---|
| 29 | S ADD(2)=$S($G(INS1):$$DADD^RCAMADD(INS1_";DIC(36,"),1:"")
|
|---|
| 30 | I $G(INS1),'$G(INS2) D MRG
|
|---|
| 31 | I $G(DEB(1)) D EVNT
|
|---|
| 32 | I $G(DEB(1)),'$O(^PRCA(430,"C",DEB(1),0)) S DA=DEB(1),DIK="^RCD(340," D ^DIK
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | ;
|
|---|
| 36 | INS2(ROOT,COUNT) ; Check secondary or tertiary insurance fields
|
|---|
| 37 | ; Input: ROOT -- Global root for table of carriers to be repointed
|
|---|
| 38 | ; COUNT -- Passed by reference; # of fields updated
|
|---|
| 39 | N BN,BN0,P
|
|---|
| 40 | S (BN,COUNT)=0
|
|---|
| 41 | F S BN=$O(^PRCA(430,BN)) Q:'BN S BN0=$G(^PRCA(430,+BN,0)) I $G(BN0) D
|
|---|
| 42 | .F P=19,20 I $P(BN0,"^",P),$D(@ROOT@($P(BN0,"^",P))) D
|
|---|
| 43 | ..S $P(^PRCA(430,+BN,0),"^",P)=@ROOT@($P(BN0,"^",P))
|
|---|
| 44 | ..S COUNT=COUNT+1
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ATDX ;Fix "ATD" cross-reference
|
|---|
| 48 | S X=0 F S X=$O(^RCD(340,X)) Q:'X I $D(^RCD(340,+X,0)),(^(0)'["DPT"),$D(^PRCA(433,"ATD",X)) K ^PRCA(433,"ATD",X)
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | MRG ;Change debtor on bills
|
|---|
| 52 | S BN=0 F S BN=$O(^PRCA(430,"C",DEB(1),BN)) Q:'BN I $D(^PRCA(430,+BN,0)) D
|
|---|
| 53 | .S DA=BN,DIE="^PRCA(430,",DR="9////"_DEB(2) D ^DIE
|
|---|
| 54 | .I $P($G(^PRCA(430,+BN,0)),"^")]"" S ^TMP("RCAMINS",$J,$P($G(^PRCA(430,+BN,0)),"^"))=""
|
|---|
| 55 | .D BILL^IBCNSCD1($P($P($G(^PRCA(430,+DA,0)),"^"),"-",2),INS,INS1)
|
|---|
| 56 | S XMSUB="ACCOUNTS RECEIVABLE INSURANCE CO. MERGE/DELETION"
|
|---|
| 57 | S ^TMP($J,"MSG",17)="The following bills were affected:"
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | EVNT ;Change AR EVENTS
|
|---|
| 61 | F ETYP=1,9 S EDAT=0 F S EDAT=$O(^RC(341,"AD",DEB(1),ETYP,EDAT)) Q:'EDAT D
|
|---|
| 62 | .S EVNT=0 F S EVNT=$O(^RC(341,"AD",DEB(1),ETYP,EDAT,EVNT)) Q:'EVNT D
|
|---|
| 63 | ..I DEB(2) S DA=EVNT,DIE="^RC(341,",DR=".05////"_DEB(2) D ^DIE K DA
|
|---|
| 64 | ..I 'DEB(2) S DA=EVNT,DIK="^RC(341," D ^DIK K DA
|
|---|
| 65 | K DA,DIE,DR
|
|---|
| 66 | D MAIL^RCAMINS1
|
|---|
| 67 | Q
|
|---|
