Changeset 1616 for fmts


Ignore:
Timestamp:
Apr 10, 2013, 9:50:51 PM (11 years ago)
Author:
Sam Habiel
Message:

Now code add drugs to drug file. Still needs lot more work.

Location:
fmts/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • fmts/trunk/p/C0XPT0.m

    r1609 r1616  
    1 C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-21  4:52 PM
     1C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-04-10  4:23 PM
    22 ;;1.1;FILEMAN TRIPLE STORE;;
    33 ;
     
    2626 SET PARAM("MRN")=$$MRN(DEM)
    2727 NEW RETURN
     28 WRITE !!,PARAM("NAME"),!
    2829 D ADDPT(.RETURN,.PARAM)
    2930 N DFN S DFN=$P(RETURN(1),U,2)
  • fmts/trunk/p/C0XPT3.m

    r1613 r1616  
    1 C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-02-22  3:38 PM
     1C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-04-10  6:54 PM
    22        ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
    33        ;
     
    77        D ONETYPE^C0XGET3($NA(^TMP($J,"MEDS")),G,"sp:Medication")
    88        ;
     9        ; PRIVATE TO SAM -- PRIVATE TO SAM -- PRIVATE TO SAM
     10        ; Delete the old drugs for this patient
     11        N DIK,DA
     12        S DIK="^PS(55,",DA=DFN D ^DIK ; bye bye
     13        S DIK="^PSRX(" F DA=0:0 S DA=$O(^PSRX(DA)) Q:'DA  D:$P(^(DA,0),U,2)=DFN ^DIK
     14        S DIK="^OR(100," F DA=0:0 S DA=$O(^OR(100,DA)) Q:'DA  D:+$P(^(DA,0),U,2)=DFN ^DIK
     15        ; PRIVATE TO SAM -- PRIVATE TO SAM -- PRIVATE TO SAM
     16        ;
    917        ; For each medication (C0XI = COUNTER; S = Medication Node as Subject)
    1018        N C0XI,S F C0XI=0:0 S C0XI=$O(^TMP($J,"MEDS",C0XI)) Q:'C0XI  S S=^(C0XI) DO MED1(G,S,DFN)
     
    3947        N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name
    4048        ;
    41         W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN,!
     49        W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN," ",RXN,!
    4250        ;
    4351        ; 6. Get Fill Dates
     
    6169        . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
    6270        ;
    63         ; ZWRITE:$D(FILLS) FILLS
     71        ZWRITE:$D(FILLS) FILLS
    6472        ;
    6573        D
     
    8189        ; 6. Coded sig (FVALUE, FUNIT, DOSE, DUNIT)
    8290        ; 7. Fill label log section of Rx? Maybe not.
     91        ;
     92        I '$$EXIST^C0CRXNLK(RXN) S $EC=",U1," ; Invalid RxNorm code passed.
     93        ;
    8394        N ORZPT,PSODFN S (ORZPT,PSODFN)=DFN  ;"" ;POINTER TO PATIENT FILE (#2)
    8495        N PNTSTAT S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
    8596        N PROV S PROV=$$NP^C0XPT0() ;NEW PERSON FILE (#200)
    86         N PSODRUG S PSODRUG=94558 ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN
     97        I $$ISBRAND^C0CRXNLK(RXN) S RXN=$$BR2GEN^C0CRXNLK(RXN) ; Get Generic Drug for Brand
     98        N LOCALDRUG S LOCALDRUG=+$$RXN2MEDS^C0CRXNLK(RXN)
     99        I 'LOCALDRUG S LOCALDRUG=$$ADDDRUG(RXN)
     100        W "(debug) Local Drug IEN: "_LOCALDRUG,!
     101        N PSODRUG S PSODRUG=LOCALDRUG  ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN
    87102        S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
    88103        N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required)
     
    109124        N REASON S REASON="E" ;Activity log ; SET ([E]dit)
    110125        N INIT S INIT=.5 ;NEW PERSON FILE (#200)
    111         N COM S COM="Oupatient medication order." ;TEXT
    112126        N SIG S SIG=INST ;#51,.01
    113127        ;
     
    120134        ;
    121135        L +^PSRX(0):0 ; Lock zero node while we get the record.
    122         N PSOIEN S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 ; Next available IEN
     136        N PSOIEN S PSOIEN=$O(^PSRX(" "),-1)+1 ; Next available IEN
    123137        I $D(^PSRX(PSOIEN)) S $EC=",U1," ; Next number not available. File issue.
    124138        S $P(^PSRX(0),U,3)=PSOIEN ; Reset next available number.
     
    160174        . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",3)=INIT ;NEW PERSON FILE (#200)
    161175        . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",4)=0 ;NUMBER - RX REFERENCE
    162         . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",5)="Imported from Smart" ;TEXT
     176        . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",5)="Imported from Smart"
    163177        . ;
    164178        . Q:C0XFILL=FILDT  ; Don't add refill data for first fill!
     
    220234        Q
    221235        ;
     236ADDDRUG(RXN,NDC,BARCODE) ; Public Proc; Add Drug to Drug File
     237 ; Input: RXN - RxNorm Semantic Clinical Drug CUI by Value. Required.
     238 ; Input: NDC - Drug NDC by Value. Optional. Pass in 11 digit format without dashes.
     239 ; Input: BARCODE - Wand Barcode. Optional. Pass exactly as wand reads minus control characters.
     240 ; Output: None.
     241 ;
     242 ; Prelim Checks
     243 I '$G(RXN) S $EC=",U1," ; Required
     244 I $L($G(NDC)),$L(NDC)'=11 S $EC=",U1,"
     245 ;
     246 N PSSZ S PSSZ=1    ; Needed for the drug file to let me in!
     247 ;
     248 ; If RXN refers to a brand drug, get the generic instead.
     249 I $$ISBRAND^C0CRXNLK(RXN) S RXN=$$BR2GEN^C0CRXNLK(RXN)
     250 W !,"(debug) RxNorm is "_RXN,!
     251 ;
     252 ; Get first VUID for this RxNorm drug
     253 N VUID S VUID=+$$RXN2VUI^C0CRXNLK(RXN)
     254 Q:'VUID
     255 W "(debug) VUID for RxNorm CUI "_RXN_" is "_VUID,!
     256 ;
     257 ; IEN in 50.68
     258 N C0XVUID ; For Searching Compound Index
     259 S C0XVUID(1)=VUID
     260 S C0XVUID(2)=1
     261 N F5068IEN S F5068IEN=$$FIND1^DIC(50.68,"","XQ",.C0XVUID,"AMASTERVUID")
     262 Q:'F5068IEN
     263 W "F 50.68 IEN (debug): "_F5068IEN,!
     264 ;
     265 ; FDA Array
     266 N C0XFDA
     267 ;
     268 ; Name, shortened
     269 S C0XFDA(50,"+1,",.01)=$E($$GET1^DIQ(50.68,F5068IEN,.01),1,40)
     270 ;
     271 ; File BarCode as a Synonym for BCMA
     272 I $L($G(BARCODE)) D
     273 . S C0XFDA(50.1,"+2,+1,",.01)=BARCODE
     274 . S C0XFDA(50.1,"+2,+1,",1)="Q"
     275 ;
     276 ; Brand Names
     277 N BNS S BNS=$$RXN2BNS^C0CRXNLK(RXN) ; Brands
     278 I $L(BNS) N I F I=1:1:$L(BNS,U) D
     279 . N IENS S IENS=I+2
     280 . S C0XFDA(50.1,"+"_IENS_",+1,",.01)=$$UP^XLFSTR($E($P(BNS,U,I),1,40))
     281 . S C0XFDA(50.1,"+"_IENS_",+1,",1)="T"
     282 ;
     283 ; NDC (string)
     284 I $G(NDC) S C0XFDA(50,"+1,",31)=$E(NDC,1,5)_"-"_$E(NDC,6,9)_"-"_$E(NDC,10,11)
     285 ;
     286 ; Dispense Unit (string)
     287 S C0XFDA(50,"+1,",14.5)=$$GET1^DIQ(50.68,F5068IEN,"VA DISPENSE UNIT")
     288 ;
     289 ; National Drug File Entry (pointer to 50.6)
     290 S C0XFDA(50,"+1,",20)="`"_$$GET1^DIQ(50.68,F5068IEN,"VA GENERIC NAME","I")
     291 ;
     292 ; VA Product Name (string)
     293 S C0XFDA(50,"+1,",21)=$E($$GET1^DIQ(50.68,F5068IEN,.01),1,70)
     294 ;
     295 ; PSNDF VA PRODUCT NAME ENTRY (pointer to 50.68)
     296 S C0XFDA(50,"+1,",22)="`"_F5068IEN
     297 ;
     298 ; DEA, SPECIAL HDLG (string)
     299 D  ; From ^PSNMRG
     300 . N CS S CS=$$GET1^DIQ(50.68,F5068IEN,"CS FEDERAL SCHEDULE","I")
     301 . S CS=$S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
     302 . S C0XFDA(50,"+1,",3)=CS
     303 ;
     304 ; NATIONAL DRUG CLASS (pointer to 50.605) (triggers VA Classification field)
     305 S C0XFDA(50,"+1,",25)="`"_$$GET1^DIQ(50.68,F5068IEN,"PRIMARY VA DRUG CLASS","I")
     306 ;
     307 ; Right Now, I don't file the following which ^PSNMRG does (cuz I don't need them)
     308 ; - Package Size (derived from NDC/UPN file)
     309 ; - Package Type (ditto)
     310 ; - CMOP ID (from $$PROD2^PSNAPIS)
     311 ; - National Formulary Indicator (from 50.68)
     312 ;
     313 ; Next Step is to kill Old OI if Dosage Form doesn't match
     314 ; Won't do that here as it's assumed any drugs that's added is new.
     315 ; This happens at ^PSNPSS
     316 ;
     317 ; Next Step: Kill off old doses and add new ones. We need to to that.
     318 ; TODO: Add doses. Happens at EN1^PSSUTIL.
     319 N C0XERR,C0XIEN
     320 D UPDATE^DIE("E","C0XFDA","C0XIEN","C0XERR")
     321 ;
     322 S:$D(C0XERR) $EC=",U1,"
     323 ;
     324 QUIT C0XIEN(1)
Note: See TracChangeset for help on using the changeset viewer.