source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBYAPT1.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: 3.8 KB
Line 
1IBYAPT1 ;ALB/CPM - PATCH IB*2*28 INSURANCE CLEAN-UP ; 30-JAN-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
3 ;
4BKG ; Queue off a background job to clean up various insurance files.
5 W !!,">>> Queuing off a job to clean up various insurance files..."
6 W !," (You'll get a message when the job is completed)",!
7 S ZTRTN="FIX^IBYAPT1",ZTDTH=$H,ZTIO=""
8 S ZTDESC="IB - PATCH IB*2*28 POST INIT - INSURANCE CLEAN-UP"
9 D ^%ZTLOAD
10 W !?4,$S($D(ZTSK):"The job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job. Please run FIX^IBYAPT1 at any time.")
11 K ZTSK
12 Q
13 ;
14 ;
15FIX ; Perform clean-up of Insurance Company files.
16 ;
17 D NOW^%DTC S IBBDT=%
18 ;
19 D PLAN ; Clean up x-refs in file #355.3
20 D AB ; Delete errant Annual Benefits from file #355.4
21 D BU ; Delete errant Benefits Used from file #355.5
22 D RIDER ; Delete errant Riders from file #355.7
23 D IR ; Repoint 'Insurance Company Contacted' for
24 ; Insurance Reviews in file 356.2
25 ;
26 D NOW^%DTC S IBEDT=%
27 ;
28 D MAIL ; send out results
29 K IBBDT,IBEDT,IBR,IBC,IBV,IBP,IBPD,IBV1,IBCT,IBT,IBX,XMSUB,XMTEXT,XMDUZ,XMY,Y
30 Q
31 ;
32 ;
33 ;
34PLAN ; Clean up the 'AGNU' and 'AGNA' x-refs in file #355.3
35 F IBR="AGNA","AGNU" D
36 .S IBC=0 F S IBC=$O(^IBA(355.3,IBR,IBC)) Q:'IBC D
37 ..S IBV="" F S IBV=$O(^IBA(355.3,IBR,IBC,IBV)) Q:IBV="" D
38 ...S IBP=0 F S IBP=$O(^IBA(355.3,IBR,IBC,IBV,IBP)) Q:'IBP D
39 ....S IBPD=$G(^IBA(355.3,IBP,0))
40 ....S IBV1=$P(IBPD,"^",$S(IBR="AGNA":3,1:4))
41 ....I +IBPD'=IBC!(IBV'=IBV1) S IBCT(IBR)=$G(IBCT(IBR))+1 K ^IBA(355.3,IBR,IBC,IBV,IBP)
42 Q
43 ;
44AB ; Delete errant Annual benefits from file #355.4
45 S IBC=0 F S IBC=$O(^IBA(355.4,IBC)) Q:'IBC S IBX=$G(^(IBC,0)) D
46 .S IBV=0 I '$P(IBX,"^",2) S IBV=1
47 .I 'IBV,'$D(^IBA(355.3,+$P(IBX,"^",2),0)) S IBV=1
48 .I IBV S DA=IBC,DIK="^IBA(355.4,",DIDEL=355.4 D ^DIK S IBCT("AB")=$G(IBCT("AB"))+1
49 Q
50 ;
51BU ; Delete errant Benefits Used from file #355.5
52 S IBC=0 F S IBC=$O(^IBA(355.5,IBC)) Q:'IBC S IBX=$G(^(IBC,0)) D
53 .S IBV=0 I 'IBX S IBV=1
54 .I 'IBV,'$D(^IBA(355.3,+IBX,0)) S IBV=1
55 .I 'IBV,$P($G(^DPT(+$P(IBX,"^",2),.312,+$P(IBX,"^",17),0)),"^",18)'=+IBX S IBV=1
56 .I IBV S DA=IBC,DIK="^IBA(355.5,",DIDEL=355.5 D ^DIK S IBCT("BU")=$G(IBCT("BU"))+1
57 Q
58 ;
59RIDER ; Delete errant Riders from file #355.7
60 S IBC=0 F S IBC=$O(^IBA(355.7,IBC)) Q:'IBC S IBX=$G(^(IBC,0)) D
61 .S IBV=0 I '$D(^DPT(+$P(IBX,"^",2),.312,+$P(IBX,"^",3),0)) S IBV=1
62 .I IBV S DA=IBC,DIK="^IBA(355.7,",DIDEL=355.7 D ^DIK S IBCT("RD")=$G(IBCT("RD"))+1
63 Q
64 ;
65IR ; Repoint Insurance Reviews in file #356.2
66 S IBC=0 F S IBC=$O(^IBT(356.2,IBC)) Q:'IBC S IBX=$G(^(IBC,0)),IBX1=$G(^(1)) D
67 .S IBCDFN=+$P(IBX1,"^",5),IBCDFND=$G(^DPT(+$P(IBX,"^",5),.312,IBCDFN,0))
68 .K IBVAL
69 .I IBCDFN,IBCDFND,+$P(IBX,"^",8)'=+IBCDFND S IBVAL=+IBCDFND
70 .I IBCDFN,'IBCDFND S IBVAL=0
71 .I $G(IBVAL)]"" D
72 ..I IBVAL S DA=IBC,DR=".08////"_+IBCDFND,DIE="^IBT(356.2," D ^DIE K DIE,DA,DR
73 ..I 'IBVAL S $P(^IBT(356.2,IBC,1),"^",5)=""
74 ..S IBCT("IR")=$G(IBCT("IR"))+1
75 K IBX1,IBCDFN,IBCDFND,IBVAL
76 Q
77 ;
78MAIL ; Send results out.
79 S XMSUB="Patch IB*2*28 Insurance Clean-up Completion"
80 S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT(",XMY(DUZ)=""
81 ;
82 K IBT
83 S IBT(1)="The Insurance Files clean-up job has completed."
84 S IBT(2)=" "
85 S Y=IBBDT D D^DIQ S IBT(3)="Job Start Time: "_Y
86 S Y=IBEDT D D^DIQ S IBT(4)=" Job End Time: "_Y
87 S IBT(5)=" "
88 S IBT(6)=" Number of AGNA cross references in file #355.3 deleted: "_+$G(IBCT("AGNA"))
89 S IBT(7)=" Number of AGNU cross references in file #355.3 deleted: "_+$G(IBCT("AGNU"))
90 S IBT(8)="Number of errant Annual Benefits in file #355.4 deleted: "_+$G(IBCT("AB"))
91 S IBT(9)=" Number of errant Benefits Used in file #355.5 deleted: "_+$G(IBCT("BU"))
92 S IBT(10)="Number of errant Personal Riders in file #355.7 deleted: "_+$G(IBCT("RD"))
93 S IBT(11)=" Number of Insurance Reviews in file #356.2 repointed: "_+$G(IBCT("IR"))
94 ;
95 D ^XMD
96 Q
Note: See TracBrowser for help on using the repository browser.