source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBYEPT1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1IBYEPT1 ;ALB/CPM - PATCH IB*2*40 POST INIT (CON'T) ; 22-AUG-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**40**; 21-MAR-94
3 ;
4EN ; Entry point to queue 'Name of Insured' clean up job.
5 ;
6 W !!,">>> I need to queue a job to clean up the 'Name of Insured' fields in"
7 W !," the PATIENT (#2) and BILL/CLAIMS (#399) files...",!
8 ;
9 ; - queue the job
10 S ZTRTN="DQ^IBYEPT1",ZTIO="",ZTDESC="IB - CORRECT 'NAME OF INSURED' VALUES"
11 D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"")
12 W:$D(ZTSK) !,"Please note that you will receive a mail message when this job has completed."
13 K X,Y,DIRUT,DUOUT,DTOUR,DIROUT,ZTSK
14 Q
15 ;
16 ;
17 ;
18DQ ; Queued entry point to start the job.
19 ;
20 D NOW^%DTC S IBBDT=%
21 ;
22 S (IBCPOL,IBCBILL)=0
23 ;
24 ; - fix policies in file #2
25 S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN S IBCDFN=0 F S IBCDFN=$O(^DPT(DFN,.312,IBCDFN)) Q:'IBCDFN S IBNI=$P($G(^(IBCDFN,0)),"^",17) I IBNI?1"`"1.N D
26 .S IBNAM=$$NAME(IBNI,DFN) Q:IBNAM<0
27 .S $P(^DPT(DFN,.312,IBCDFN,0),"^",17)=IBNAM,IBCPOL=IBCPOL+1
28 ;
29 ; - fix patient's bills in file #399
30 S IBIFN=0 F S IBIFN=$O(^DGCR(399,IBIFN)) Q:'IBIFN D
31 .F IBNOD="I1","I2","I3" S IBNI=$P($G(^DGCR(399,IBIFN,IBNOD)),"^",17) I IBNI?1"`"1.N D
32 ..S IBNAM=$$NAME(IBNI,+$P($G(^DGCR(399,IBIFN,0)),"^",2)) Q:IBNAM<0
33 ..S $P(^DGCR(399,IBIFN,IBNOD),"^",17)=IBNAM,IBCBILL=IBCBILL+1
34 ;
35 D NOW^%DTC S IBEDT=%
36 ;
37 D MAIL
38 ;
39 K IBBDT,IBEDT,DFN,IBCDFN,IBNI,IBNAM,IBCPOL,IBCBILL,IBIFN,IBNOD
40 Q
41 ;
42 ;
43NAME(IBNI,DFN) ; Find the name associated with the ien for Name of Insured.
44 ; Input: IBNI -- Value of the Name of Insured stored in the policy
45 ; DFN -- Pointer to the patient in file #2
46 ;
47 N NAME
48 I $E(IBNI,2,99)=DFN S NAME=$P($G(^DPT(DFN,0)),"^") G NAMEQ
49 N DIC,DFN,DGSENFLG,X S DGSENFLG=1
50 S X=IBNI,DIC="^DPT(",DIC(0)="Z" D ^DIC S NAME=$S(Y<0:-1,1:$P($G(^DPT(+Y,0)),"^"))
51NAMEQ Q NAME
52 ;
53 ;
54MAIL ; Send the bulletin
55 S XMSUB="Job Completion - Correct 'Name of Insured' Fields"
56 S XMDUZ="INTEGRATED BILLING",XMTEXT="IBT(",XMY(DUZ)=""
57 ;
58 K IBT
59 S IBT(1)="The job to correct the 'Name of Insured' fields in files #2 and #399"
60 S IBT(2)="has completed."
61 S IBT(3)=" "
62 S Y=IBBDT D D^DIQ S IBT(4)="Job Start Time: "_Y
63 S Y=IBEDT D D^DIQ S IBT(5)=" Job End Time: "_Y
64 S IBT(6)=" "
65 S IBT(7)="Number of policies corrected in file #2: "_IBCPOL
66 S IBT(8)=" Number of bills corrected in file #399: "_IBCBILL
67 ;
68 D ^XMD
69 K IBT,XMSUB,XMTEXT,XMDUZ,XMY,Y
70 Q
Note: See TracBrowser for help on using the repository browser.