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

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

initial load of FOIAVistA 6/30/08 version

File size: 6.2 KB
Line 
1IBNCPUT1 ;BHAM ISC/SS - IB NCPDP UTILITIES ;22-MAR-2006
2 ;;2.0;INTEGRATED BILLING;**342,363**;21-MAR-94;Build 35
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;Utilities for NPCDP
6 ;/**
7 ;Creates a new entry (or node for multiple with .01 field)
8 ;
9 ;IBFILE - subfile# (9002313.59111) for comment
10 ;IBIEN - ien of the parent file entry in which the new subfile entry will be inserted
11 ;IBVAL01 - .01 value for the new entry
12 ;NEWRECNO -(optional) specify IEN if you want specific value
13 ; Note: "" then the system will assign the entry number itself.
14 ;IBFLGS - FLAGS parameter for UPDATE^DIE
15 ;Examples
16 ;top level:
17 ; D INSITEM(366.14,"",IBDATE,"")
18 ; D INSITEM(366.14,"",IBDATE,45)
19 ;
20 ;1st level multiple:
21 ; subfile number = #366.141
22 ; parent file #366.14 entry number = 345
23 ; D INSITEM(366.141,345,"SUBMIT","")
24 ; to create mupltiple entry with particular entry number = 23
25 ; D INSITEM(366.141,345,"SUBMIT",23)
26 ;
27 ;2nd level multiple
28 ;parent file #366.14 entry number = 234
29 ;parent multiple entry number = 55
30 ;create mupltiple entry INSURANCE
31 ; D INSITEM(366.1412,"55,234","INS","")
32 ; results in :
33 ; ^IBCNR(366.14,234,1,55,5,0)=^366.1412PA^1^1
34 ; ^IBCNR(366.14,234,1,55,5,1,0)=INS
35 ; ^IBCNR(366.14,234,1,55,5,"B","INS",1)=
36 ; (DD node for this muptiple =5 )
37 ;
38 ;output :
39 ; positive number - record # created
40 ; <=0 - failure
41 ; See description above
42INSITEM(IBFILE,IBIEN,IBVAL01,NEWRECNO,IBFLGS) ;*/
43 N IBSSI,IBIENS,IBFDA,IBERR
44 I '$G(NEWRECNO) N NEWRECNO S NEWRECNO=$G(NEWRECNO)
45 I IBIEN'="" S IBIENS="+1,"_IBIEN_"," I $L(NEWRECNO)>0 S IBSSI(1)=+NEWRECNO
46 I IBIEN="" S IBIENS="+1," I $L(NEWRECNO)>0 S IBSSI(1)=+NEWRECNO
47 S IBFDA(IBFILE,IBIENS,.01)=IBVAL01
48 D UPDATE^DIE($G(IBFLGS),"IBFDA","IBSSI","IBERR")
49 I $D(IBERR) D BMES^XPDUTL(IBERR("DIERR",1,"TEXT",1)) Q -1 ;D BMES^XPDUTL(IBERR("DIERR",1,"TEXT",1))
50 Q +$G(IBSSI(1))
51 ;
52 ;
53 ;fill fields
54 ;Input:
55 ;FILENO file number
56 ;FLDNO field number
57 ;RECIEN ien string
58 ;NEWVAL new value to file
59 ;Output:
60 ;0^ NEWVAL^error if failure
61 ;1^ NEWVAL if success
62FILLFLDS(FILENO,FLDNO,RECIEN,NEWVAL) ;
63 N RECIENS,FDA,ERRARR
64 S RECIENS=RECIEN_","
65 S FDA(FILENO,RECIENS,FLDNO)=NEWVAL
66 D FILE^DIE("","FDA","ERRARR")
67 I $D(ERRARR) Q "0^"_NEWVAL_"^"_ERRARR("DIERR",1,"TEXT",1)
68 Q "1^"_NEWVAL
69 ;
70 ;convert external value of the field EVENT TYPE to its internal value
71 ;IA# 10155
72EXT2INT(IBEXTRN) ;
73 N IBDD,IBZ,IBCNT,IBINTERN
74 S IBINTERN=-1
75 S IBDD=$P($G(^DD(366.141,.01,0)),U,3) ;IA# 10155
76 F IBCNT=1:1 S IBZ=$P(IBDD,";",IBCNT) Q:IBZ="" D Q:IBINTERN'<0
77 . I $P(IBZ,":",2)=IBEXTRN S IBINTERN=+IBZ
78 Q:IBINTERN<0 0 ;treat as UNKNOWN
79 Q IBINTERN
80 ;
81 ;
82 ;should RX copay from the entry in file #350 be placed on hold ?
83 ;called from HOLD^IBRUTL
84 ;Input:
85 ; X - zeroth node of file #350 entry
86 ;output:
87 ; 0 - NO - DO NOT PUT ON HOLD
88 ; 1 - this is RX copay but there is no ECME claim, so process it as usual
89 ; 1 - this is ECME RX copay and it should be put on HOLD
90 ; 1 - this is ECME RX copay and it was rejected or reversed
91 ; 2 - this is not RX copay
92HOLDECME(X) ;
93 N IBRXIEN,IBREFNO,IBRXZ,IBDATE,IBDFN,IBEBCOB,IBRETVAL
94 S IBRETVAL=""
95 S IBRXZ=$P($G(X),U,4),(IBRXIEN,IBREFNO)=0
96 I $P($P(IBRXZ,";"),":")'=52 Q 2 ;follow pre-existing logic
97 S IBRXIEN=+$P($P(IBRXZ,";"),":",2) ;ien in file #52
98 S IBREFNO=+$P($P($P(X,U,4),";",2),":",2) ;refill number (0 - for original)
99 S IBDFN=+$P($G(X),U,2) ;Patient ien
100 ;if this is OTC "non-e-billable" drug then DO NOT PUT ON HOLD
101 I $$OTCNEBIL(IBRXIEN)=1 Q 0
102 ;if this is non-OTC drug OR if this is OTC drug but marked as e-billable then look if it has zero amount paid
103 I $$AMNTHOLD^IBNCPUT1(IBDFN,IBRXIEN,IBREFNO)=0 Q 0 ;DO NOT PUT ON HOLD
104 Q 1 ;follow pre-existing logic
105 ;
106 ;should RX copay be placed on hold based on the PAID amount?
107 ;input:
108 ; IBDFN - patient's ien
109 ; IBRX - file #52 ien
110 ; IBREF - refill no
111 ;output:
112 ; 1 - YES
113 ; 0 - NO
114AMNTHOLD(IBDFN,IBRX,IBREF) ;
115 N IBPAYRES ;for payer's response
116 N IBADT
117 ;
118 S IBPAYRES=$$PAIDAMNT^BPSUTIL(IBRX,IBREF)
119 ;if payable AND amount paid is zero AND does not have any other Pharmacy insurance
120 ;THEN return NO - it should not be put on hold
121 I +IBPAYRES=1,$P(IBPAYRES,U,2)=0,'$$MOREINS^IBNCPNB(IBDFN,+$P(IBPAYRES,U,3)) Q 0
122 Q 1
123 ;Is this RX for OTC drug which is NOT E-billiable?
124 ;Input:
125 ; IBRX - ien in file #52
126 ;Output:
127 ; 1 - this is OTC drug and it is NOT marked as e-billable
128 ; 0 - otherwise
129OTCNEBIL(IBRX) ;
130 N ARR,IBSPHNDL,IBDRUG
131 S IBDRUG=+$$RXAPI1^IBNCPUT1(IBRX,6,"I")
132 S IBSPHNDL=$$DRUGDIE^IBNCPUT1(IBDRUG,3,"E",.ARR)
133 I IBSPHNDL'["9" Q 0 ;this is not OTC drug
134 I IBSPHNDL["E" Q 0 ;it is OTC E-billable drug
135 ;it is OTC NON E-billable drug
136 Q 1
137 ;
138 ;Function to return field data from DRUG file (#50)
139 ; Parameters
140 ; IBIEN50 - IEN of DRUG FILE #50
141 ; IBFLDN - Field Number(s) (like .01)
142 ; IBEXIN - Specifies internal or external value of returned field
143 ; - optional, defaults to "I"
144 ; IBARR50 - Array to return value(s). Optional. Pass by reference.
145 ; See EN^DIQ documentation for variable DIQ
146 ;
147 ; Function returns field data if one field is specified. If
148 ; multiple fields, the function will return "" and the field
149 ; values are returned in IBARR50
150 ; Example: W $$DRUGDIE^IBNCPUT1(134,25,"E",.ARR)
151DRUGDIE(IBIEN50,IBFLDN,IBEXIN,IBARR50) ; Return field values for Drug file
152 I $G(IBIEN50)=""!($G(IBFLDN)="") Q ""
153 N DIQ,PSSDIY
154 N IBDIQ
155 I $G(IBEXIN)'="E" S IBEXIN="I"
156 S IBDIQ="IBARR50",IBDIQ(0)=IBEXIN
157 D EN^PSSDI(50,"IB",50,.IBFLDN,.IBIEN50,.IBDIQ)
158 Q $G(IBARR50(50,IBIEN50,IBFLDN,IBEXIN))
159 ;
160 ;/*
161 ;Function to return a value for a SINGLE field of file #52
162 ;DBIA 4858
163 ;input:
164 ; IBIEN52 - ien of file #52
165 ; IBFLDN - one single field, for example ".01"
166 ; IBFORMAT -
167 ; "E" for external format
168 ; "I" - internal
169 ; "N" - do not return nulls
170 ; default is "E"
171 ;output:
172 ; returns a field value or null (empty string)
173 ; examples:
174 ;W $$RXAPI1^IBNCPUT1(504733,6,"E")
175 ;ALBUMIN 25% 50ML
176 ;W $$RXAPI1^IBNCPUT1(504733,6,"I")
177 ;134
178RXAPI1(IBIEN52,IBFLDN,IBFORMAT) ;*/
179 N DIQ,DIC,IBARR,X,Y,D0,PSODIY
180 N I,J,C,DA,DRS,DIL,DI,DIQ1
181 N IBDIQ
182 S IBDIQ="IBARR"
183 S IBDIQ(0)=$S($G(IBFORMAT)="":"E",1:IBFORMAT)
184 D DIQ^PSODI(52,52,.IBFLDN,.IBIEN52,.IBDIQ) ;DBIA 4858
185 Q $S(IBDIQ(0)="N":$G(IBARR(52,IBIEN52,IBFLDN)),1:$G(IBARR(52,IBIEN52,IBFLDN,IBDIQ(0))))
186 ;
187 ;
188 ;IBNCPUT1
Note: See TracBrowser for help on using the repository browser.