1 | C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-04-19 5:42 PM
|
---|
2 | ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
|
---|
3 | ; (C) Sam Habiel 2013
|
---|
4 | ; Proprietary code. Stay out!
|
---|
5 | ;
|
---|
6 | MEDS(G,DFN) ; Private Proc; Extract Medication Data from a Patient's Graph
|
---|
7 | ; G - Patient Graph, DFN - you should know this
|
---|
8 | K ^TMP($J,"MEDS")
|
---|
9 | D ONETYPE^C0XGET3($NA(^TMP($J,"MEDS")),G,"sp:Medication")
|
---|
10 | ;
|
---|
11 | ; PRIVATE TO SAM -- PRIVATE TO SAM -- PRIVATE TO SAM
|
---|
12 | ; Delete the old drugs for this patient
|
---|
13 | N DIK,DA
|
---|
14 | S DIK="^PS(55,",DA=DFN D ^DIK ; bye bye
|
---|
15 | S DIK="^PSRX(" F DA=0:0 S DA=$O(^PSRX(DA)) Q:'DA D:$P(^(DA,0),U,2)=DFN ^DIK
|
---|
16 | S DIK="^OR(100," F DA=0:0 S DA=$O(^OR(100,DA)) Q:'DA D:+$P(^(DA,0),U,2)=DFN ^DIK
|
---|
17 | ; PRIVATE TO SAM -- PRIVATE TO SAM -- PRIVATE TO SAM
|
---|
18 | ;
|
---|
19 | ; For each medication (C0XI = COUNTER; S = Medication Node as Subject)
|
---|
20 | N C0XI,S F C0XI=0:0 S C0XI=$O(^TMP($J,"MEDS",C0XI)) Q:'C0XI S S=^(C0XI) DO MED1(G,S,DFN)
|
---|
21 | K ^TMP($J,"MEDS")
|
---|
22 | QUIT
|
---|
23 | ;
|
---|
24 | MED1(G,S,DFN) ; Private Procedure; Process each medication in Graph.
|
---|
25 | ; G = Graph; S = Medication Description ID as subject.
|
---|
26 | ;
|
---|
27 | ; 1. Start Date; obtain and then conv to fileman format
|
---|
28 | N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,S,"sp:startDate") ; Duh! Start Date.
|
---|
29 | D
|
---|
30 | . N %DT,X,Y S X=STARTDT D ^%DT S STARTDT=Y ; New stack level for variables.
|
---|
31 | ;
|
---|
32 | ;DEBUG.ASSERT that STARTDT is greater than 1900
|
---|
33 | I STARTDT'>2000000 S $EC=",U1,"
|
---|
34 | ;
|
---|
35 | ; 2. Frequency
|
---|
36 | N FVALUE S FVALUE=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:value")
|
---|
37 | N FUNIT S FUNIT=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:unit")
|
---|
38 | ;
|
---|
39 | ; 3. Dose Quantity
|
---|
40 | ; Get value, get unit and strip the braces out.
|
---|
41 | N DOSE S DOSE=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:value")
|
---|
42 | N DUNIT S DUNIT=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:unit"),DUNIT=$TR(DUNIT,"{}")
|
---|
43 | ;
|
---|
44 | ; 4. Instructions
|
---|
45 | N INST S INST=$$GSPO1^C0XGET3(G,S,"sp:instructions")
|
---|
46 | ;
|
---|
47 | ; 5. Drug Name and Code
|
---|
48 | N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code"),RXN=$P(RXN,"/",$L(RXN,"/")) ; RxNorm Code
|
---|
49 | N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name
|
---|
50 | ;
|
---|
51 | W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN," ",RXN,!
|
---|
52 | ;
|
---|
53 | ; 6. Get Fill Dates
|
---|
54 | N FULF ; Fulfillments
|
---|
55 | D GSPO^C0XGET3($NA(FULF),G,S,"sp:fulfillment")
|
---|
56 | ;
|
---|
57 | N FILLS ; Fills array. Contains every time a drug was dispensed.
|
---|
58 | N FILL S FILL="" F S FILL=$O(FULF(FILL)) Q:FILL="" D
|
---|
59 | . N S S S=FULF(FILL) ; New subject; subsumes above one in this loop
|
---|
60 | . ;
|
---|
61 | . ; Dispense Date
|
---|
62 | . N FILLDATE S FILLDATE=$$GSPO1^C0XGET3(G,S,"dcterms:date")
|
---|
63 | . D
|
---|
64 | . . N %DT,X,Y S X=FILLDATE D ^%DT S FILLDATE=Y
|
---|
65 | . I FILLDATE<2000000 W $EC=",U1," ; Converstion error
|
---|
66 | . ;
|
---|
67 | . S FILLS(RXN,FILLDATE,"sp:dispenseDaysSupply")=$$GSPO1^C0XGET3(G,S,"sp:dispenseDaysSupply") ; Self Explanatory?
|
---|
68 | . ;
|
---|
69 | . ; Get quantity value and unit
|
---|
70 | . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:value")=$$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:value")
|
---|
71 | . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
|
---|
72 | ;
|
---|
73 | ZWRITE:$D(FILLS) FILLS
|
---|
74 | ;
|
---|
75 | D
|
---|
76 | . N FILDT,FILQTY,FILDAYS
|
---|
77 | . S FILDT=$O(FILLS(RXN,""))
|
---|
78 | . I FILDT S FILQTY=FILLS(RXN,FILDT,"sp:quantityDispensed.sp:value"),FILDAYS=FILLS(RXN,FILDT,"sp:dispenseDaysSupply")
|
---|
79 | . E S (FILQTY,FILDAYS)=""
|
---|
80 | . D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,.FILLS)
|
---|
81 | ;
|
---|
82 | QUIT
|
---|
83 | ;
|
---|
84 | PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,FILLS) ;
|
---|
85 | ; TODO:
|
---|
86 | ; 1. Resolve medication
|
---|
87 | ; 2. Figure out what to do with meds that have no fill history (omit?)
|
---|
88 | ; 3. Don't file a med twice! Check ^PXRMINDX to make sure it aint there first
|
---|
89 | ; 4. Compute the number of refills for original number so that remaining refills aren't displayed as negative
|
---|
90 | ; 5. Original fill doesn't have a dispense comment
|
---|
91 | ; 6. Coded sig (FVALUE, FUNIT, DOSE, DUNIT)
|
---|
92 | ; 7. Fill label log section of Rx? Maybe not.
|
---|
93 | ;
|
---|
94 | I '$$EXIST^C0CRXNLK(RXN) S $EC=",U1," ; Invalid RxNorm code passed.
|
---|
95 | ;
|
---|
96 | N ORZPT,PSODFN S (ORZPT,PSODFN)=DFN ;"" ;POINTER TO PATIENT FILE (#2)
|
---|
97 | N PNTSTAT S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
|
---|
98 | N PROV S PROV=$$NP^C0XPT0() ;NEW PERSON FILE (#200)
|
---|
99 | I $$ISBRAND^C0CRXNLK(RXN) S RXN=$$BR2GEN^C0CRXNLK(RXN) ; Get Generic Drug for Brand
|
---|
100 | N LOCALDRUG S LOCALDRUG=+$$RXN2MEDS^C0CRXNLK(RXN)
|
---|
101 | ; I 'LOCALDRUG S LOCALDRUG=$$ADDDRUG^C0CRXNAD(RXN)
|
---|
102 | I LOCALDRUG N DIK,DA S DIK="^PSDRUG(",DA=LOCALDRUG D ^DIK
|
---|
103 | S LOCALDRUG=$$ADDDRUG^C0CRXNAD(RXN)
|
---|
104 | W "(debug) Local Drug IEN: "_LOCALDRUG,!
|
---|
105 | N PSODRUG S PSODRUG=LOCALDRUG ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN
|
---|
106 | S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
|
---|
107 | N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required)
|
---|
108 | N DAYSUPLY S DAYSUPLY=FILDAYS ;NUMBER ; 0;8 NUMBER (Required);
|
---|
109 | N REFIL S REFIL=0 ;NUMBER ; 0;9 NUMBER (Required)
|
---|
110 | N ORDCONV S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
|
---|
111 | N COPIES S COPIES=1 ;NUMBER
|
---|
112 | N MLWIND S MLWIND="W" ; Mail/Window: 'M' or 'W'
|
---|
113 | N ENTERBY S ENTERBY=.5 ;NEW PERSON FILE (#200) - POSTMASTER
|
---|
114 | N UNITPRICE S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
|
---|
115 | N PSOSITE S PSOSITE=$O(^PS(59,0)) ; OUTPATIENT SITE FILE (#59); get first one
|
---|
116 | N %,LOGDT D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
|
---|
117 | N FILLDT S FILLDT=FILDT ;DATE; First fill date from our data.
|
---|
118 | N ISSDT S ISSDT=FILLDT ;DATE
|
---|
119 | N DISPDT S DISPDT=ISSDT ;DATE
|
---|
120 | N X D
|
---|
121 | . N X1,X2
|
---|
122 | . S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
|
---|
123 | N EXPIRDT S EXPIRDT=X ;
|
---|
124 | N PORDITM S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
|
---|
125 | N STATUS S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
|
---|
126 | N TRNSTYP S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
|
---|
127 | N LDISPDT S LDISPDT=FILLDT ; 3;1 DATE
|
---|
128 | N REASON S REASON="E" ;Activity log ; SET ([E]dit)
|
---|
129 | N INIT S INIT=.5 ;NEW PERSON FILE (#200)
|
---|
130 | N SIG S SIG=INST ;#51,.01
|
---|
131 | ;
|
---|
132 | CREATE ; fall through
|
---|
133 | ;
|
---|
134 | N PSONEW
|
---|
135 | D AUTO^PSONRXN ;RX auto number
|
---|
136 | I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on!
|
---|
137 | N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again...
|
---|
138 | ;
|
---|
139 | L +^PSRX(0):0 ; Lock zero node while we get the record.
|
---|
140 | N PSOIEN S PSOIEN=$O(^PSRX(" "),-1)+1 ; Next available IEN
|
---|
141 | I $D(^PSRX(PSOIEN)) S $EC=",U1," ; Next number not available. File issue.
|
---|
142 | S $P(^PSRX(0),U,3)=PSOIEN ; Reset next available number.
|
---|
143 | S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
|
---|
144 | L +^PSRX(PSOIEN):0 ; Lock record node
|
---|
145 | L -^PSRX(0) ; Unlock zero node, we now got it
|
---|
146 | ;
|
---|
147 | S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required)
|
---|
148 | S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2)
|
---|
149 | S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53)
|
---|
150 | S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200)
|
---|
151 | S $P(^PSRX(PSOIEN,0),"^",5)="" ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44)
|
---|
152 | S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50)
|
---|
153 | S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required)
|
---|
154 | S $P(^PSRX(PSOIEN,0),"^",8)=DAYSUPLY ;NUMBER ; 0;8 NUMBER (Required)
|
---|
155 | S $P(^PSRX(PSOIEN,0),"^",9)=REFIL ;NUMBER ; 0;9 NUMBER (Required)
|
---|
156 | S $P(^PSRX(PSOIEN,0),"^",11)=MLWIND ;'M' or 'W'
|
---|
157 | S $P(^PSRX(PSOIEN,0),"^",16)=ENTERBY ;NEW PERSON FILE (#200)
|
---|
158 | S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER
|
---|
159 | S $P(^PSRX(PSOIEN,0),"^",18)=COPIES ;COPIES
|
---|
160 | S $P(^PSRX(PSOIEN,0),"^",19)=ORDCONV ;ORDER CONVERTED 0;19 SET ['1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;]
|
---|
161 | ;
|
---|
162 | S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required)
|
---|
163 | S $P(^PSRX(PSOIEN,2),"^",2)=FILLDT ;FILL DATE
|
---|
164 | ;S $P(^PSRX(PSOIEN,2),"^",3)=PHARMACIST ; "" ; PHARMACIST ;2;3 POINTER TO NEW PERSON FILE (#200)
|
---|
165 | ;S $P(^PSRX(PSOIEN,2),"^",4)="" ; LOT # 2;4 FREE TEXT
|
---|
166 | S $P(^PSRX(PSOIEN,2),"^",5)=DISPDT ; DISPENSED DATE 2;5 DATE (Required)
|
---|
167 | S $P(^PSRX(PSOIEN,2),"^",6)=EXPIRDT ;"" ; EXPIRATION DATE
|
---|
168 | S $P(^PSRX(PSOIEN,2),"^",9)=PSOSITE ;2;9 POINTER TO OUTPATIENT SITE FILE (#59)
|
---|
169 | ;
|
---|
170 | S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE 3;1 DATE
|
---|
171 | ;
|
---|
172 | N C0XFILL S C0XFILL=""
|
---|
173 | N C0XREFCT S C0XREFCT=0
|
---|
174 | F S C0XFILL=$O(FILLS(RXN,C0XFILL)) Q:C0XFILL="" D
|
---|
175 | . S ^PSRX(PSOIEN,"A",0)="^52.3DA"_U_(C0XREFCT+1)_U_(C0XREFCT+1)
|
---|
176 | . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",1)=LOGDT ;DATE
|
---|
177 | . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",2)="N" ;SET ; Dispensed using external interface
|
---|
178 | . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",3)=INIT ;NEW PERSON FILE (#200)
|
---|
179 | . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",4)=0 ;NUMBER - RX REFERENCE
|
---|
180 | . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",5)="Imported from Smart"
|
---|
181 | . ;
|
---|
182 | . Q:C0XFILL=FILDT ; Don't add refill data for first fill!
|
---|
183 | . ;
|
---|
184 | . ; Increment counter
|
---|
185 | . S C0XREFCT=C0XREFCT+1
|
---|
186 | . ;
|
---|
187 | . S ^PSRX(PSOIEN,1,0)="^52.1DA"_U_(C0XREFCT)_U_(C0XREFCT)
|
---|
188 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",1)=C0XFILL ; REFILL DATE [D]
|
---|
189 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",2)=MLWIND ; MAIL/WINDOW [RS]
|
---|
190 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",3)="Imported from Smart" ; REMARKS [F]
|
---|
191 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",4)=FILLS(RXN,C0XFILL,"sp:quantityDispensed.sp:value") ; QTY [RNJ12,2X]
|
---|
192 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",5)=.5 ; PHARMACIST NAME [*P200']
|
---|
193 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",6)="" ; LOT [F]
|
---|
194 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",7)=.5 ; CLERK CODE [RP200']
|
---|
195 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",8)="" ; LOGIN DATE [D]
|
---|
196 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",9)="" ; DIVISION [RP59']
|
---|
197 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",17)=PROV ; PROVIDER [R*P200X'I]
|
---|
198 | . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",19)=C0XFILL ; DISPENSED DATE [RD]
|
---|
199 | ;
|
---|
200 | S ^PSRX(PSOIEN,"OR1")=PORDITM ;PHARMACY ORDERABLE ITEM FILE (#50.7)
|
---|
201 | ;
|
---|
202 | S $P(^PSRX(PSOIEN,"POE"),"^",1)=1 ; POE RX POE;1 SET ['1' FOR YES;]
|
---|
203 | ;
|
---|
204 | S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required) medication instruction DIC(51)
|
---|
205 | S $P(^PSRX(PSOIEN,"SIG"),"^",2)=0 ;OERR SIG (SET: 0 for NO; 1 for YES)
|
---|
206 | ;
|
---|
207 | S $P(^PSRX(PSOIEN,"STA"),"^",1)=STATUS ;STA;1 SET (Required) ; '0' FOR ACTIVE;
|
---|
208 | ;
|
---|
209 | ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1)
|
---|
210 | S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER
|
---|
211 | D OERR(PSOIEN),F55,F52(PSOIEN),F525
|
---|
212 | L -PSRX(PSOIEN) ; Unlock record
|
---|
213 | Q
|
---|
214 | ;
|
---|
215 | OERR(PSOIEN) ;UPDATES OR1 NODE
|
---|
216 | ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL
|
---|
217 | S $P(^PSRX(PSOIEN,"OR1"),"^",2)=""
|
---|
218 | N PSXRXIEN,STAT,PSSTAT,COMM,PSNOO
|
---|
219 | S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W"
|
---|
220 | D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO)
|
---|
221 | QUIT
|
---|
222 | F55 ; - File data into ^PS(55)
|
---|
223 | ;S PSODFN=DFN
|
---|
224 | S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^"
|
---|
225 | F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1))
|
---|
226 | S ^PS(55,PSODFN,"P",PSOX1,0)=PSOIEN,$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1)
|
---|
227 | S:$P($G(^PSRX(PSOIEN,2)),"^",6) ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
|
---|
228 | K PSOX1
|
---|
229 | Q
|
---|
230 | F52(PSOIEN) ;; - Re-indexing file 52 entry
|
---|
231 | N DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK
|
---|
232 | Q
|
---|
233 | ;
|
---|
234 | F525 ;UPDATE SUSPENSE FILE
|
---|
235 | Q:$G(^PSRX(PSOIEN,"STA"))'=5
|
---|
236 | S DA=PSOIEN,X=PSOIEN,FDT=$P($G(^PSRX(PSOIEN,2)),"^",2),TYPE=$P($G(^PSRX(PSOIEN,0)),"^",11)
|
---|
237 | S DIC="^PS(52.5,",DIC(0)="L",DLAYGO=52.5,DIC("DR")=".02///"_FDT_";.03////"_$P(^PSRX(PSOIEN,0),"^",2)_";.04////"_TYPE_";.05///0;.06////"_DIV_";2///0" K DD,D0 D FILE^DICN K DD,D0
|
---|
238 | Q
|
---|
239 | ;
|
---|
240 | ADDDRUG(RXN,NDC,BARCODE) ; Public Proc; Add Drug to Drug File
|
---|
241 | ; Input: RXN - RxNorm Semantic Clinical Drug CUI by Value. Required.
|
---|
242 | ; Input: NDC - Drug NDC by Value. Optional. Pass in 11 digit format without dashes.
|
---|
243 | ; Input: BARCODE - Wand Barcode. Optional. Pass exactly as wand reads minus control characters.
|
---|
244 | ; Output: None.
|
---|
245 | ;
|
---|
246 | ; Prelim Checks
|
---|
247 | I '$G(RXN) S $EC=",U1," ; Required
|
---|
248 | I $L($G(NDC)),$L(NDC)'=11 S $EC=",U1,"
|
---|
249 | ;
|
---|
250 | N PSSZ S PSSZ=1 ; Needed for the drug file to let me in!
|
---|
251 | ;
|
---|
252 | ; If RXN refers to a brand drug, get the generic instead.
|
---|
253 | I $$ISBRAND^C0CRXNLK(RXN) S RXN=$$BR2GEN^C0CRXNLK(RXN)
|
---|
254 | W !,"(debug) RxNorm is "_RXN,!
|
---|
255 | ;
|
---|
256 | ; Get first VUID for this RxNorm drug
|
---|
257 | N VUID S VUID=+$$RXN2VUI^C0CRXNLK(RXN)
|
---|
258 | Q:'VUID
|
---|
259 | W "(debug) VUID for RxNorm CUI "_RXN_" is "_VUID,!
|
---|
260 | ;
|
---|
261 | ; IEN in 50.68
|
---|
262 | N C0XVUID ; For Searching Compound Index
|
---|
263 | S C0XVUID(1)=VUID
|
---|
264 | S C0XVUID(2)=1
|
---|
265 | N F5068IEN S F5068IEN=$$FIND1^DIC(50.68,"","XQ",.C0XVUID,"AMASTERVUID")
|
---|
266 | Q:'F5068IEN
|
---|
267 | W "F 50.68 IEN (debug): "_F5068IEN,!
|
---|
268 | ;
|
---|
269 | ; FDA Array
|
---|
270 | N C0XFDA
|
---|
271 | ;
|
---|
272 | ; Name, shortened
|
---|
273 | S C0XFDA(50,"+1,",.01)=$E($$GET1^DIQ(50.68,F5068IEN,.01),1,40)
|
---|
274 | ;
|
---|
275 | ; File BarCode as a Synonym for BCMA
|
---|
276 | I $L($G(BARCODE)) D
|
---|
277 | . S C0XFDA(50.1,"+2,+1,",.01)=BARCODE
|
---|
278 | . S C0XFDA(50.1,"+2,+1,",1)="Q"
|
---|
279 | ;
|
---|
280 | ; Brand Names
|
---|
281 | N BNS S BNS=$$RXN2BNS^C0CRXNLK(RXN) ; Brands
|
---|
282 | I $L(BNS) N I F I=1:1:$L(BNS,U) D
|
---|
283 | . N IENS S IENS=I+2
|
---|
284 | . S C0XFDA(50.1,"+"_IENS_",+1,",.01)=$$UP^XLFSTR($E($P(BNS,U,I),1,40))
|
---|
285 | . S C0XFDA(50.1,"+"_IENS_",+1,",1)="T"
|
---|
286 | ;
|
---|
287 | ; NDC (string)
|
---|
288 | I $G(NDC) S C0XFDA(50,"+1,",31)=$E(NDC,1,5)_"-"_$E(NDC,6,9)_"-"_$E(NDC,10,11)
|
---|
289 | ;
|
---|
290 | ; Dispense Unit (string)
|
---|
291 | S C0XFDA(50,"+1,",14.5)=$$GET1^DIQ(50.68,F5068IEN,"VA DISPENSE UNIT")
|
---|
292 | ;
|
---|
293 | ; National Drug File Entry (pointer to 50.6)
|
---|
294 | S C0XFDA(50,"+1,",20)="`"_$$GET1^DIQ(50.68,F5068IEN,"VA GENERIC NAME","I")
|
---|
295 | ;
|
---|
296 | ; VA Product Name (string)
|
---|
297 | S C0XFDA(50,"+1,",21)=$E($$GET1^DIQ(50.68,F5068IEN,.01),1,70)
|
---|
298 | ;
|
---|
299 | ; PSNDF VA PRODUCT NAME ENTRY (pointer to 50.68)
|
---|
300 | S C0XFDA(50,"+1,",22)="`"_F5068IEN
|
---|
301 | ;
|
---|
302 | ; DEA, SPECIAL HDLG (string)
|
---|
303 | D ; From ^PSNMRG
|
---|
304 | . N CS S CS=$$GET1^DIQ(50.68,F5068IEN,"CS FEDERAL SCHEDULE","I")
|
---|
305 | . S CS=$S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
|
---|
306 | . S C0XFDA(50,"+1,",3)=CS
|
---|
307 | ;
|
---|
308 | ; NATIONAL DRUG CLASS (pointer to 50.605) (triggers VA Classification field)
|
---|
309 | S C0XFDA(50,"+1,",25)="`"_$$GET1^DIQ(50.68,F5068IEN,"PRIMARY VA DRUG CLASS","I")
|
---|
310 | ;
|
---|
311 | ; Right Now, I don't file the following which ^PSNMRG does (cuz I don't need them)
|
---|
312 | ; - Package Size (derived from NDC/UPN file)
|
---|
313 | ; - Package Type (ditto)
|
---|
314 | ; - CMOP ID (from $$PROD2^PSNAPIS)
|
---|
315 | ; - National Formulary Indicator (from 50.68)
|
---|
316 | ;
|
---|
317 | ; Next Step is to kill Old OI if Dosage Form doesn't match
|
---|
318 | ; Won't do that here as it's assumed any drugs that's added is new.
|
---|
319 | ; This happens at ^PSNPSS
|
---|
320 | ;
|
---|
321 | ; Next Step: Kill off old doses and add new ones. We need to to that.
|
---|
322 | ; TODO: Add doses. Happens at EN1^PSSUTIL.
|
---|
323 | N C0XERR,C0XIEN
|
---|
324 | D UPDATE^DIE("E","C0XFDA","C0XIEN","C0XERR")
|
---|
325 | ;
|
---|
326 | S:$D(C0XERR) $EC=",U1,"
|
---|
327 | ;
|
---|
328 | QUIT C0XIEN(1)
|
---|