source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSQ2.m@ 1742

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1BPSOSQ2 ;BHAM ISC/FCS/DRS/DLF - form transmission packets ;06/01/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ; Construct packets for transmission
5 Q
6 ;
7PACKETS ; EP - Tasked by BPSOSQA
8 ;
9 ; Initialize
10 N ERROR,RXILIST,STATUS
11 ;
12 ; First handle insurer alseep transactions
13 D STATUS31^BPSOSQF
14 ;
15 ; Handle claims that need the packet to be built
16 I $D(^BPST("AD",30)) D STATUS30
17 ;
18 ; If there are still any claims with status 30 (perhaps due to failed
19 ; LOCK59), queue up BPSOSQ2 to run again
20 I $O(^BPST("AD",30,0)) H 60 D TASK^BPSOSQA
21 Q
22 ;
23 ; Walk through claims at 30%, bundle, and create the claim
24STATUS30 ;
25 N IEN59
26 S IEN59=""
27 I '$$LOCK59(30) Q
28 ;
29 ; Loop though claims at 30%, bundle with other 30% claims, and process
30 F S IEN59=$$NEXT59(IEN59,30) Q:IEN59="" D
31 . ; Intialize the list
32 . K RXILIST
33 . S RXILIST(IEN59)=""
34 . ;
35 . ; Update the status to 40 (Building the packet)
36 . D SETSTAT^BPSOSU(IEN59,40)
37 . ;
38 . ; If reversal, only one claim per packet
39 . I $G(^BPST(IEN59,4)) G POINTX
40 . ;
41 . ; If prior auth are entered, only one claim per packet
42 . G:$$CHKPA() POINTX
43 . ;
44 . ; Code below is for bundling claims. The VA is not doing this
45 . ; so we are skipping it. However, the code is left here in
46 . ; case we do bundling in the future. If so, the code will need to be
47 . ; rewritten to look at the corect fields.
48 . G POINTX
49 . ;
50 . N RA0,RA1 S RA0=^BPST(IEN59,0),RA1=^(1)
51 . N IEN59 S IEN59="" ; preserve the top-level index!
52 . F S IEN59=$$NEXT59(IEN59,30) Q:'IEN59 D
53 .. N RB0,RB1 S RB0=^BPST(IEN59,0),RB1=^(1)
54 .. ; Only bundle when you have the same:
55 .. ; Patient, Visit, Division, Division Source, Insurer, Pharmacy
56 .. I $P(RA0,U,6,7)'=$P(RB0,U,6,7) Q
57 .. I $P(RA1,U,4,7)'=$P(RB1,U,4,7) Q
58 .. I $P(RB0,U,2)'=30 Q ; might have been canceled, or maybe 31'd
59 .. D SETSTAT^BPSOSU(IEN59,40)
60 .. S RXILIST(IEN59)=""
61POINTX . ; Reversals and prior auth claims branch to here to bypass multi-claim packeting
62 . ;
63 . ; BPSOSQG will build the claim data, create the packet, and send to HL7
64 . S ERROR=$$PACKET^BPSOSQG
65 . ;
66 . ; If an error is returned, log the error to each transaction
67 . I ERROR S IEN59="" F S IEN59=$O(RXILIST(IEN59)) Q:IEN59="" D
68 .. D ERROR^BPSOSU($T(+0),IEN59,$P(ERROR,U),$P(ERROR,U,2,$L(ERROR,U)))
69 D UNLOCK59(30)
70 Q
71 ;
72NEXT59(IEN59,STATUS) ;EP - BPSOSQF
73 N INS,PAYSH,PAYSHNM,RETRY
74N59A ;
75 ; Get next transaction for the given status
76 S IEN59=$O(^BPST("AD",STATUS,IEN59))
77 I IEN59="" Q IEN59 ; end of list, return ""
78 ;
79 ; but if the insurer is asleep, don't take this one
80 S INS=$P(^BPST(IEN59,9),U,1)
81 ;
82 ; Not sure when this would happen, but do not want to take it out
83 I INS="" S INS=1,$P(^BPST(IEN59,9),U,1)=INS ;LJE;8/25/03 ;current insurance
84 ;
85 ; Get the payer sheet, name, and retry time
86 S PAYSH=$$PAYERSH^BPSOSQF(IEN59)
87 S PAYSHNM=$$GET1^DIQ(9002313.92,PAYSH_",",.01,"E")
88 S RETRY=$$GET1^DIQ(9002313.92,PAYSH_",",1.12,"I") ;RETRY TIME
89 ;
90 ; If no retry time, insurer is not asleep and we can return the transaction
91 I 'RETRY Q IEN59
92 ;
93 ; Insurer is asleep -
94 ; If necessary, update the .59's record of when to retry
95 I $P($G(^BPST(IEN59,8)),U)'=RETRY D ;
96 . S $P(^BPST(IEN59,8),U)=RETRY ; stamp with latest retry time
97 . D SETSTAT^BPSOSU(IEN59,31) ; force screen update, too
98 . D LOG^BPSOSL(IEN59,$T(+0)_"-Insurer still asleep - retry at "_RETRY_" for "_$G(PAYSHNM))
99 ;
100 ; If time to retry, return this transaction for processing
101 I RETRY'>$$NOW Q IEN59
102 ;
103 ; If we are checking status 30, convert to insurer asleep
104 I STATUS=30 D
105 . D SETSTAT^BPSOSU(IEN59,31)
106 . S $P(^BPST(IEN59,8),U)=$P($G(^BPSF(9002313.92,PAYSH,1)),"^",12)
107 . S $P(^BPST(IEN59,8),U,3)=PAYSH
108 ;
109 ; Still asleep, go to next transaction
110 G N59A
111 ;
112 ;
113LOCK59(STATUS) ;EP - BPSOSQF
114 L +^BPST("AD",STATUS):60
115 Q $T
116 ;
117UNLOCK59(STATUS) ;EP - BPSOSQF
118 L -^BPST("AD",STATUS)
119 Q
120 ;
121CHKPA() ;
122 N PATYP,PANUM,PACLM
123 S PACLM=0
124 ;
125 S PATYP=$P($G(^BPST(IEN59,1)),U,15) ;prior auth type code
126 S PANUM=$P($G(^BPST(IEN59,1)),U,9) ;prior auth number
127 I ($G(PATYP)'="")!($G(PANUM)'="") S PACLM=1
128 ;
129 Q PACLM
130 ;
131NOW() N %,%H,%I,X D NOW^%DTC Q %
Note: See TracBrowser for help on using the repository browser.