source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSCD2.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBCNSCD2 ;ALB/CPM - DELETE INSURANCE COMPANY (CON'T) ; 03-FEB-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 ;
5MAIL ; Send results out.
6 S XMSUB="Insurance Company Deletion Clean-up Completion"
7 S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="^TMP($J,""IBT"",",XMY(DUZ)=""
8 ;
9 K ^TMP($J,"IBT") S IBC=0
10 D SET("The final clean-up for deleted Insurance Company(s) has completed.")
11 D SET(" ")
12 S Y=IBBDT D D^DIQ D SET("Job Start Time: "_Y)
13 S Y=IBEDT D D^DIQ D SET(" Job End Time: "_Y)
14 ;
15 D SET(" ")
16 D SET("DELETED COMPANY"_$J("",24)_"REPOINTED TO")
17 D SET($TR($J("",79)," ","="))
18 S IBX=0 F S IBX=$O(^TMP($J,"IBCNSCD",IBX)) Q:'IBX S IBX1=+$G(^(IBX)) D
19 .S X=$E($P($G(^DIC(36,IBX,0)),"^")_" (#"_IBX_")"_$J("",39),1,39)
20 .S X=X_$S(IBX1:$P($G(^DIC(36,IBX1,0)),"^")_" (#"_IBX1_")",1:"not repointed")
21 .D SET(X)
22 ;
23 D SET(" ")
24 D SET(" ")
25 D SET("1. Correction of the Disposition (sub-file #2.101) field")
26 D SET(" 'INJURING PARTIES INSURANCE' (#25)")
27 D SET(" Number of Disposition records updated: "_+$G(IBCT("DIS")))
28 I $O(IBCT("DIS",0)) D
29 .D SET($J("",8)_"The following dispositions had this field deleted and not merged:")
30 .S DFN=0 F S DFN=$O(IBCT("DIS",DFN)) Q:'DFN D
31 ..S IBNAM=$$PT^IBEFUNC(DFN),IBH=0
32 ..S IBX=$J("",10)_$E($P(IBNAM,"^"),1,25)_" ("_$P(IBNAM,"^",3)_")"
33 ..S IBDAT="" F S IBDAT=$O(IBCT("DIS",DFN,IBDAT)) Q:IBDAT="" D
34 ...S IBDAT1="Date/Time: "_$$DAT2^IBOUTL(9999999-IBDAT)
35 ...I 'IBH D SET($E(IBX_$J("",45),1,45)_IBDAT1)
36 ...E D SET($J("",45)_IBDAT1)
37 ...S IBH=1
38 ;
39 ; - insurance companies
40 S IBINS(0)="REPOINT PATIENTS TO^.16"
41 S IBINS(.12)="CLAIMS (INPT) COMPANY NAME^.127"
42 S IBINS(.13)="PRECERT COMPANY NAME^.139"
43 S IBINS(.14)="APPEALS COMPANY NAME^.147"
44 S IBINS(.16)="CLAIMS (OPT) COMPANY NAME^.167"
45 S IBINS(.18)="CLAIMS (RX) COMPANY NAME^.187"
46 D SET(" ")
47 D SET("2. Correction of other Insurance Company (file #36) records:")
48 S IBX="" F S IBX=$O(IBINS(IBX)) Q:IBX="" S IBS=IBINS(IBX) D
49 .D SET(" Number of records with '"_$P(IBS,"^")_"' (#"_$P(IBS,"^",2)_") updated: "_+$G(IBCT("INS",IBX)))
50 .I $O(IBCT("INS",IBX,0)) D
51 ..D SET($J("",8)_"The following companies had this field deleted and not merged:")
52 ..S IBCO=0 F S IBCO=$O(IBCT("INS",IBX,IBCO)) Q:'IBCO D
53 ...D SET($J("",10)_$P($G(^DIC(36,IBCO,0)),"^")_" (ien "_IBCO_")")
54 ;
55 ; - insurance reviews
56 D SET(" ")
57 D SET("3. Correction of the Insurance Review (file #356.2) field")
58 D SET(" 'INSURANCE COMPANY CONTACTED' (#.08)")
59 D SET(" Number of Insurance Review records updated: "_+$G(IBCT("IR")))
60 I $O(IBCT("IR",0)) D
61 .D SET($J("",8)_"The following Insurance reviews had this field deleted and not merged:")
62 .S DFN=0 F S DFN=$O(IBCT("IR",DFN)) Q:'DFN D
63 ..S IBNAM=$$PT^IBEFUNC(DFN),IBH=0
64 ..S IBX=$J("",10)_$E($P(IBNAM,"^"),1,25)_" ("_$P(IBNAM,"^",3)_")"
65 ..S IBDAT="" F S IBDAT=$O(IBCT("IR",DFN,IBDAT)) Q:IBDAT="" D
66 ...S IBDAT1="Review Date/Time: "_$$DAT2^IBOUTL(IBDAT)
67 ...I 'IBH D SET($E(IBX_$J("",45),1,45)_IBDAT1)
68 ...E D SET($J("",45)_IBDAT1)
69 ...S IBH=1
70 ;
71 ; - bills
72 K IBINS
73 S IBINS(1)="PRIMARY INSURANCE CARRIER^101"
74 S IBINS(2)="SECONDARY INSURANCE CARRIER^102"
75 S IBINS(3)="TERTIARY INSURANCE CARRIER^103"
76 D SET(" ")
77 D SET("4. Correction of Bill/Claims (file #399) records:")
78 S IBX="" F S IBX=$O(IBINS(IBX)) Q:IBX="" S IBS=IBINS(IBX) D
79 .D SET(" Number of records with '"_$P(IBS,"^")_"' (#"_$P(IBS,"^",2)_") updated: "_+$G(IBCT("BL",IBX)))
80 .I $O(IBCT("BL",IBX,0)) D
81 ..D SET($J("",8)_"The following bills had this field deleted and not merged:")
82 ..S IBCO=0 F S IBCO=$O(IBCT("BL",IBX,IBCO)) Q:'IBCO D
83 ...S IBS=$G(^DGCR(399,IBCO,0))
84 ...S IBNAM=$$PT^IBEFUNC(+$P(IBS,"^",2))
85 ...D SET($J("",10)_$E($E($P(IBNAM,"^"),1,25)_" ("_$P(IBNAM,"^",3)_")"_$J("",35),1,35)_"Bill #: "_$P(IBS,"^"))
86 ;
87 ; - receivables in AR
88 D SET(" ")
89 D SET("5. Number of updated secondary and tertiary carriers of AR receivables: "_+$G(IBCTAR))
90 ;
91 D ^XMD
92 K ^TMP($J,"IBT")
93 Q
94 ;
95SET(X) ; Set Message Text Array
96 S IBC=IBC+1,^TMP($J,"IBT",IBC)=X
97 Q
Note: See TracBrowser for help on using the repository browser.