source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOS57.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1BPSOS57 ;BHAM ISC/FCS/DRS/FLS - BPS Log of Transactions Utils ;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 Q
5 ; Numerous BPS Log of Transaction functions are here
6 ; Each assumes that IEN57 is defined
7 ; Originally copied from BPSOSQ
8 ;
9PREVIOUS(N57) ;
10 I '$D(N57) S N57=IEN57
11 N RXI,RXR S RXI=$P(^BPSTL(N57,1),U,11)
12 S RXR=$P(^BPSTL(N57,1),U)
13 I RXI=""!(RXR="") Q ""
14 Q $O(^BPSTL("NON-FILEMAN","RXIRXR",RXI,RXR,N57),-1)
15LAST57(RXI,RXR) Q $O(^BPSTL("NON-FILEMAN","RXIRXR",RXI,RXR,""),-1)
16DRGDFN() ; EP - BPS Log of Transaction field
17 N RXI
18 S RXI=$$RXI
19 I 'RXI Q ""
20 Q $$RXAPI1^BPSUTIL1(RXI,6,"I") ; Given IEN57, return DRGDFN
21DRGNAME() ; EP - BPS Log of Transaction field
22 N RXI
23 S RXI=$$RXI
24 I 'RXI Q ""
25 Q $$RXAPI1^BPSUTIL1(RXI,6,"E") ; Given IEN57, return DRGNAME
26RELDATE() ;EP - BPS Log of Transaction field
27 N RXI,RXR
28 S RXI=$$RXI,RXR=$$RXR
29 I 'RXI Q ""
30 I RXR Q $$REFAPI1^BPSUTIL1(RXI,RXR,17,"I")
31 Q $$RXAPI1^BPSUTIL1(RXI,31,"I")
32RXI() Q $P(^BPSTL(IEN57,1),U,11) ; Given IEN57, return RXI
33RXR() Q $P(^BPSTL(IEN57,1),U,1) ; Given IEN57, return RXR
34NDC() Q $P(^BPSTL(IEN57,1),U,2)
35QTY() Q $P(^BPSTL(IEN57,5),U) ; Given IEN57, return quantity
36AMT() Q $P(^BPSTL(IEN57,5),U,5) ; return total $amount
37CHG() Q $P(^BPSTL(IEN57,5),U,5) ; Given IEN57, ret total charge
38INSIEN() Q $P(^BPSTL(IEN57,1),U,6)
39PATIENT() Q $P(^BPSTL(IEN57,0),U,6)
40HRN() ; Health record number and facility abbreviation
41 ; Called by BPS Log of Transaction field
42 Q 0
43USER() N X S X=$P(^BPSTL(IEN57,0),U,10) S:'X X=$G(DUZ) Q X
44NOW() N %,%H,%I,X D NOW^%DTC Q %
45ISREVERS(N) ;EP - BPSOSIY
46 ; Returns reversal claim #, else false
47 N X S X=$G(^BPSTL(N,4)) Q:X="" 0
48 I X Q $P(X,U) ; reversal of electronic claim
49 Q 0
50REVACC(N) ;EP - BPSOSIY
51 ; was this an accepted reversal? return true or false
52 ; Treat Duplicate of Accepted Reversal ("S") as accepted
53 N X
54 S X=$$REVRESP(N)
55 Q X="A"!(X="S")
56REVRESP(N) ;
57 N RESP S RESP=$P(^BPSTL(N,4),U,2)
58 I 'RESP Q "?"
59 N X S X=$$RESP500^BPSOSQ4(RESP,"I")
60 Q X ; Should be "A" or "R" - can be "S" (Duplicate of Accepted Reversal)
61 ;
62POSITION() ; return pointer to position within claim (D1)
63 Q $P($G(^BPSTL(IEN57,0)),U,9)
64IEN02() ; return pointer to claim
65 Q $P($G(^BPSTL(IEN57,0)),U,4)
66IEN03() ; return pointer to response
67 Q $P($G(^BPSTL(IEN57,0)),U,5)
68REVIEN02() ; return pointer to reversal claim
69 Q $P($G(^BPSTL(IEN57,4)),U)
70REVIEN03() ; return pointer to reversal response
71 Q $P($G(^BPSTL(IEN57,4)),U,2)
72FIELD(F,REV) ; EP - BPS Log of Transaction fields
73 ; Retrieve field F from claim or response - Given IEN57
74 ; Returns value
75 ; Special for reject codes: F=511 gets ","-delimited string of codes
76 ; F=511.01 gets first code, F=511.02 gets second one, etc.
77 N X,IEN02,IEN03,POS,IEN57 S IEN57=D0
78 S POS=$$POSITION,IEN02=$$IEN02,IEN03=$$IEN03
79 I $G(REV) S IEN02=$$REVIEN02,IEN03=$$REVIEN03
80 ;
81 ; Validate IENs
82 I 'IEN02 Q ""
83 I 'POS,F=308!(F>400) Q ""
84 I 'IEN03,F>500 Q ""
85 ;
86 ; Get Data
87 I F<400,F'=308 S X=$$GET1^DIQ(9002313.02,IEN02_",",F,"I")
88 E I F=308!(F>400&(F<500)) S X=$$GET1^DIQ(9002313.0201,POS_","_IEN02_",",F,"I")
89 E I F=501!(F=524) S X=$$GET1^DIQ(9002313.03,IEN03_",",F,"I")
90 E I F\1=511 D REJCODES S:F#1 X=$G(X(F#1*100))
91 E S X=$$GET1^DIQ(9002313.0301,POS_","_IEN03_",",F,"I")
92 ;
93 ; Do format conversions
94 F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1)
95 D STRIPID ; strip field ID, if any
96 D MONEY ; money fields, where appropriate
97 D OTHER ; other special conversions
98 Q X
99 ;
100REJCODES ; rejection codes for IEN03
101 ; X = ","-delimited string of two-char codes
102 ; X(j)=code_" "_description
103 K X S X=""
104 N I,J S (I,J)=0
105 F S I=$O(^BPSR(IEN03,1000,POS,511,I)) Q:'I D
106 . N A S A=$P(^BPSR(IEN03,1000,POS,511,I,0),U) Q:'A
107 . S A=$O(^BPSF(9002313.93,"B",A,0)) Q:'A
108 . S A=^BPSF(9002313.93,A,0)
109 . S:X]"" X=X_"," S X=X_$P(A,U)
110 . S J=J+1,X(J)=$P(A,U)_" "_$P(A,U,2)
111 Q
112 ;
113STRIPID ; some fields have two-character field ID
114 ; and first eliminate all those that don't:
115 Q:F<307 Q:F=308
116 I F>400,F<500 Q:F<410 Q:F=411 Q:F=414 Q:F=415 Q:F=419 Q:F=420 Q:F=426
117 ;IHS/DSD/lwj 10/02 nxt line changed on behalf of David Slauenwhite
118 I F>500 Q:F<512 Q:F=525 Q:F=526 ;DS 10/11/01
119 S X=$E(X,3,$L(X))
120 Q
121MONEY ; some fields are money fields in signed overpunch format
122 Q:F<400
123 ;IHS/DSD/lwj 10/02 nxt line changed on behalf of David Slauenwhite
124 I F>400,F<500 I F'=409,F'=410,F'=426,F'=430,F'=431,F'=433,F'=438,F'=428,F'=412 Q
125 I F>500 Q:F<505 Q:F=510 Q:F\1=511 Q:F=522 Q:F>523
126 S X=+$$DFF2EXT^BPSECFM(X)
127 I X=0 S X="" ; so [CAPTIONED] doesn't print it
128 Q
129OTHER ; other special conversions
130 I F=442 S X=X/1000 Q ; metric decimal quantity
131 Q
Note: See TracBrowser for help on using the repository browser.