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

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1IB20P375 ;ALB/CXW - IB*2.0*375 POST INIT ;14-MAY-07
2 ;;2.0;INTEGRATED BILLING;**375**;21-MAR-94;Build 4
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;1) Update the transmission status with "X" for MRA 2nd bills in
6 ; field/file (.03/364) based on these criteria:
7 ; bill authorized but not transmitted in field/file (.13/399)
8 ; bill has at least one Medicare MRA in field/file (.04/361.1)
9 ; bill has been passed to AR & generated in file (430)
10 ; bill's status is active in field/file (8/430)
11 ; bill has no total amount collected in field/file (15/433)
12 ; bill exists in file (364) for EDI transmission
13 ; bill has no batch # associated in field/file (.02/364)
14 ; bill is not ready for extract in field/file (.03/364)
15 ; bill's COB Sequence is Secondary in field/file (.08/364)
16 ;
17 ;2) Update the CLAM MRA STATUS with VALID MRA RECEIVED in field/file
18 ; (24/399) if bill has at least one Medicare MRA, otherwise store
19 ; NO MRA NEEDED status.
20 ;
21 ;3) List of all claims excludes ACTIVE AR status with 0 total amount
22 ; collected.
23 ;
24 ;Output-XTMP("IB20P375",0)=purge date_U_today_U_patch #
25 ; 1,0)=update transmit status_U_total bills
26 ; IEN)=IBIFN_U_Bill #_U_statement covers from dt
27 ; 2,0)=list of claims_U_total bills
28 ; IBIFN)=IBIFN_U_Bill #_U_IEN AR status_U_AR total
29 ; amount collected
30 ;
31 ;
32 ;
33 ;Not delete XTMP file until 30 days from now
34 Q
35POST ;
36START D MES^XPDUTL("** ALL RECORDS ARE IN ^XTMP(""IB20P375"") WHEN THE PROCESS HAS BEEN COMPLETED **")
37 D MES^XPDUTL(" >> Starting the Post init routine ...")
38 ;
39 N ARACT,ARAMT,IB375,IBIFN,IBMRA,IBILL,IBAR,IBCDT,IBDA,IBST,IBEDI,IBCT1,IBCT2,U,X,X1,X2,DA,DIE,DR
40 S U="^",IB375="IB20P375",(IBCT1,IBCT2)=0
41 K ^XTMP(IB375)
42 S DT=$$DT^XLFDT,X1=DT,X2=30 D C^%DTC
43 S ^XTMP(IB375,0)=X_U_DT_U_"IB*2.0*375 POST-INIT"
44 S ^XTMP(IB375,1,0)="Updating the transmit status in file 364 for MRA secondary claim"
45 S ^XTMP(IB375,2,0)="List of all claims excludes ACTIVE AR Status with 0 Total Amount Collected"
46 ;
47 S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AST",3,IBIFN)) Q:'IBIFN D
48 . S IBMRA=$$MRACNT^IBCEMU1(IBIFN),IBILL=$P($G(^DGCR(399,IBIFN,0)),U),IBAR=$$BILL^RCJIBFN2(IBIFN),IBCDT=$P($G(^DGCR(399,IBIFN,"U")),U,1),ARACT=$P(IBAR,U,2),ARAMT=$P(IBAR,U,4)
49 . ;update CLAIM MRA STATUS
50 . I +$P($G(^DGCR(399,IBIFN,"TX")),U,5) D
51 .. N IBMST,DIE,DA,DR S IBMST=0 ; assume no MRA needed
52 .. S:IBMRA IBMST="C" ;Medicare MRA on file
53 .. S DIE=399,DA=IBIFN,DR="24///"_IBMST
54 .. D ^DIE
55 . ;quit if bill no Medicare MRA
56 . Q:'IBMRA
57 . I ARACT'=16!ARAMT D ;no active status or total amt collected do list
58 .. S ^XTMP(IB375,2,IBIFN)=IBIFN_U_IBILL_U_ARACT_U_ARAMT
59 .. S IBCT2=IBCT2+1
60 .. ;
61 . I ARACT=16,'ARAMT D ;active status & no total amt collected
62 .. S IBDA=0 F S IBDA=$O(^IBA(364,"B",IBIFN,IBDA)) Q:'IBDA D
63 ... S IBEDI=$G(^IBA(364,IBDA,0)),IBST=$P(IBEDI,U,3)
64 ... ;
65 ... ;quit if batch # exists or ready for extract status or primary sequence
66 ... I $P(IBEDI,U,2)!(IBST="X")!($P(IBEDI,U,8)'="S") Q
67 ... N DA,DIE,DR
68 ... S DIE=364,DA=IBDA,DR=".03////X;.04///NOW" D ^DIE
69 ... S ^XTMP(IB375,1,IBDA)=IBIFN_U_IBILL_U_IBCDT,IBCT1=IBCT1+1
70 S $P(^XTMP(IB375,1,0),U,2)=IBCT1,$P(^XTMP(IB375,2,0),U,2)=IBCT2
71NOPRINT ;
72 I 'IBCT1,'IBCT2 D G END
73 . D BMES^XPDUTL(" No claims met criteria, no transmit status update, no list of claims")
74PRINT1 ;
75 D BMES^XPDUTL($P(^XTMP(IB375,1,0),U))
76 S IBDA=0
77 F S IBDA=$O(^XTMP(IB375,1,IBDA)) Q:'IBDA S IBEDI=$G(^(IBDA)) D
78 . D MES^XPDUTL(" Bill #: "_$P(IBEDI,U,2)_" Statement Covers From Date: "_$$FMTE^XLFDT($P(IBEDI,U,3))_" Transmit Status: X")
79 D MES^XPDUTL("Total "_$S(IBCT1=1:IBCT1_" bill has",1:IBCT1_" bills have")_" been updated.")
80PRINT2 ;
81 D BMES^XPDUTL($P(^XTMP(IB375,2,0),U))
82 S IBDA=0
83 F S IBDA=$O(^XTMP(IB375,2,IBDA)) Q:'IBDA S IBEDI=$G(^(IBDA)) D
84 . D MES^XPDUTL(" Bill #: "_$P(IBEDI,U,2)_" AR Status: "_$P($G(^PRCA(430.3,+$P(IBEDI,U,3),0)),U)_" Total Amount Collected: $"_$J($P(IBEDI,U,4),0,2))
85 D MES^XPDUTL("Total "_$S(IBCT2=1:IBCT2_" bill has",1:IBCT2_" bills have")_" been listed.")
86 ;
87END D BMES^XPDUTL(" >> End of the Post init routine ...")
88 Q
89 ;
Note: See TracBrowser for help on using the repository browser.