| [1619] | 1 | C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-04-19  5:42 PM | 
|---|
| [1608] | 2 | ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29 | 
|---|
| [1619] | 3 | ; (C) Sam Habiel 2013 | 
|---|
|  | 4 | ; Proprietary code. Stay out! | 
|---|
| [1607] | 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 | ; | 
|---|
| [1616] | 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 | ; | 
|---|
| [1613] | 19 | ; For each medication (C0XI = COUNTER; S = Medication Node as Subject) | 
|---|
| [1609] | 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) | 
|---|
| [1607] | 21 | K ^TMP($J,"MEDS") | 
|---|
|  | 22 | QUIT | 
|---|
| [1608] | 23 | ; | 
|---|
| [1609] | 24 | MED1(G,S,DFN) ; Private Procedure; Process each medication in Graph. | 
|---|
| [1607] | 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. | 
|---|
| [1608] | 29 | D | 
|---|
|  | 30 | . N %DT,X,Y S X=STARTDT D ^%DT S STARTDT=Y ; New stack level for variables. | 
|---|
| [1607] | 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 | 
|---|
| [1608] | 48 | N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code"),RXN=$P(RXN,"/",$L(RXN,"/")) ; RxNorm Code | 
|---|
| [1607] | 49 | N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name | 
|---|
|  | 50 | ; | 
|---|
| [1616] | 51 | W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN," ",RXN,! | 
|---|
| [1607] | 52 | ; | 
|---|
|  | 53 | ; 6. Get Fill Dates | 
|---|
| [1608] | 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 | ; | 
|---|
| [1616] | 73 | ZWRITE:$D(FILLS) FILLS | 
|---|
| [1608] | 74 | ; | 
|---|
| [1609] | 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)="" | 
|---|
| [1613] | 80 | . D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,.FILLS) | 
|---|
| [1607] | 81 | ; | 
|---|
| [1609] | 82 | QUIT | 
|---|
| [1613] | 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. | 
|---|
| [1616] | 93 | ; | 
|---|
|  | 94 | I '$$EXIST^C0CRXNLK(RXN) S $EC=",U1," ; Invalid RxNorm code passed. | 
|---|
|  | 95 | ; | 
|---|
| [1609] | 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) | 
|---|
| [1616] | 99 | I $$ISBRAND^C0CRXNLK(RXN) S RXN=$$BR2GEN^C0CRXNLK(RXN) ; Get Generic Drug for Brand | 
|---|
|  | 100 | N LOCALDRUG S LOCALDRUG=+$$RXN2MEDS^C0CRXNLK(RXN) | 
|---|
| [1619] | 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) | 
|---|
| [1616] | 104 | W "(debug) Local Drug IEN: "_LOCALDRUG,! | 
|---|
|  | 105 | N PSODRUG S PSODRUG=LOCALDRUG  ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN | 
|---|
| [1609] | 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) | 
|---|
| [1613] | 129 | N INIT S INIT=.5 ;NEW PERSON FILE (#200) | 
|---|
| [1609] | 130 | N SIG S SIG=INST ;#51,.01 | 
|---|
| [1607] | 131 | ; | 
|---|
| [1609] | 132 | CREATE ; fall through | 
|---|
| [1607] | 133 | ; | 
|---|
| [1609] | 134 | N PSONEW | 
|---|
| [1608] | 135 | D AUTO^PSONRXN ;RX auto number | 
|---|
| [1609] | 136 | I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on! | 
|---|
|  | 137 | N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again... | 
|---|
| [1607] | 138 | ; | 
|---|
| [1609] | 139 | L +^PSRX(0):0 ; Lock zero node while we get the record. | 
|---|
| [1616] | 140 | N PSOIEN S PSOIEN=$O(^PSRX(" "),-1)+1 ; Next available IEN | 
|---|
| [1609] | 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) | 
|---|
| [1613] | 144 | L +^PSRX(PSOIEN):0 ; Lock record node | 
|---|
| [1609] | 145 | L -^PSRX(0) ; Unlock zero node, we now got it | 
|---|
| [1607] | 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 | ; | 
|---|
| [1613] | 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 | 
|---|
| [1616] | 180 | . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",5)="Imported from Smart" | 
|---|
| [1613] | 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] | 
|---|
| [1607] | 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) | 
|---|
| [1608] | 210 | S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX             TYPE;1 NUMBER | 
|---|
| [1613] | 211 | D OERR(PSOIEN),F55,F52(PSOIEN),F525 | 
|---|
| [1609] | 212 | L -PSRX(PSOIEN) ; Unlock record | 
|---|
| [1607] | 213 | Q | 
|---|
|  | 214 | ; | 
|---|
| [1609] | 215 | OERR(PSOIEN)    ;UPDATES OR1 NODE | 
|---|
| [1607] | 216 | ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL | 
|---|
|  | 217 | S $P(^PSRX(PSOIEN,"OR1"),"^",2)="" | 
|---|
| [1609] | 218 | N PSXRXIEN,STAT,PSSTAT,COMM,PSNOO | 
|---|
| [1607] | 219 | S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W" | 
|---|
|  | 220 | D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO) | 
|---|
| [1609] | 221 | QUIT | 
|---|
| [1607] | 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) | 
|---|
| [1609] | 227 | S:$P($G(^PSRX(PSOIEN,2)),"^",6) ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)="" | 
|---|
| [1607] | 228 | K PSOX1 | 
|---|
|  | 229 | Q | 
|---|
| [1613] | 230 | F52(PSOIEN)     ;; - Re-indexing file 52 entry | 
|---|
|  | 231 | N DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK | 
|---|
| [1607] | 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 | ; | 
|---|
| [1616] | 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) | 
|---|