Changeset 1624 for fmts/trunk/p


Ignore:
Timestamp:
May 6, 2013, 7:19:54 PM (12 years ago)
Author:
Sam Habiel
Message:

Various fixes for drug import; better coding documentation

File:
1 edited

Legend:

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

    r1623 r1624  
    1 C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-05-06  10:21 AM
     1C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-05-06  4:35 PM
    22        ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
    33        ; (C) Sam Habiel 2013
     
    6565        . I FILLDATE<2000000 W $EC=",U1," ; Converstion error
    6666        . ;
     67        . S FILLS=$G(FILLS)+1 ; Counter for number of dispenses
    6768        . S FILLS(RXN,FILLDATE,"sp:dispenseDaysSupply")=$$GSPO1^C0XGET3(G,S,"sp:dispenseDaysSupply") ; Self Explanatory?
    6869        . ;
     
    7172        . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
    7273        ;
    73         ZWRITE:$D(FILLS) FILLS
    74         ;
     74        ; ZWRITE:$D(FILLS) FILLS
     75        ;
     76        ; Prepare to add drug to patient record
    7577        D
    7678        . 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)
     79        . S FILDT=$O(FILLS(RXN,"")) ; Get first fill.
     80        . I FILDT S FILQTY=FILLS(RXN,FILDT,"sp:quantityDispensed.sp:value"),FILDAYS=FILLS(RXN,FILDT,"sp:dispenseDaysSupply") ; extract fill data
     81        . E  S (FILQTY,FILDAYS)="",FILDT=STARTDT ; Technically, the drug is invalid since there is no fill. But this is a kludge.
     82        . D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,.FILLS) ; Add drug to patient record
    8183        ;
    8284        QUIT
    8385        ;
    84 PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,FILLS) ;
     86PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,FILLS) ; Private EP to add drug to patient record
     87        ; - DFN
     88        ; - RXN - RxNorm CUI
     89        ; - INST - Instructions (1 tablet daily etc)
     90        ; - FILDT - Earliest Fill Date
     91        ; - FILQTY - Fill quantity of earliest fill date, used as default
     92        ; - FILDAYS - Days Supply
     93        ; - FILLS - Array specificed above - ByRef
     94        ;
    8595        ; TODO:
    86         ; 1. Resolve medication
    87         ; 2. Figure out what to do with meds that have no fill history (omit?)
    8896        ; 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.
     97        ; 6. Coded sig (FVALUE, FUNIT, DOSE, DUNIT) - goes into SIG1 multiple and Med Instructions multiple
     98        ; 7. Fill label log section of Rx? Maybe not - goes into Label Date/Time multiple
     99        ; 8. ICD Diangosis multiple if we have the data
    93100        ;
    94101        I '$$EXIST^C0CRXNLK(RXN) S $EC=",U1," ; Invalid RxNorm code passed.
     
    107114        N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required)
    108115        N DAYSUPLY S DAYSUPLY=FILDAYS ;NUMBER ; 0;8 NUMBER (Required);
    109         N REFIL S REFIL=0 ;NUMBER ; 0;9 NUMBER (Required)
     116        N REFIL S REFIL=$S($G(FILLS):FILLS-1,1:0) ;NUMBER ; 0;9 NUMBER (Required) ; # of dispenses - 1, if there are any
    110117        N ORDCONV S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
    111118        N COPIES S COPIES=1 ;NUMBER
     
    149156        S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53)
    150157        S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200)
    151         S $P(^PSRX(PSOIEN,0),"^",5)="" ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44)
     158        S $P(^PSRX(PSOIEN,0),"^",5)=$$HL^C0XPT0() ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44); Default smart location
    152159        S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50)
    153160        S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required)
     
    158165        S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER
    159166        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;]
    161167        ;
    162168        S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required)
     
    169175        ;
    170176        S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE    3;1 DATE
     177        S $P(^PSRX(PSOIEN,3),U,7)="Imported from Smart" ; REMARKS FT
     178        ;
     179        S $P(^PSRX(PSOIEN,"EPH"),U,1)=0 ; DAW Code
    171180        ;
    172181        N C0XFILL S C0XFILL=""
     
    199208        ;
    200209        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;]
     210        S $P(^PSRX(PSOIEN,"OR1"),U,5)=.5 ; Finishing Person
     211        S $P(^PSRX(PSOIEN,"OR1"),U,8)=$$NOW^XLFDT() ; Finish Date/Time; seconds required.
     212        ;
    203213        ;
    204214        S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required)  medication instruction DIC(51)
     
    209219        ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE   IB ACTION TYPE FILE (#350.1)
    210220        S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX             TYPE;1 NUMBER
     221        ;
    211222        D OERR(PSOIEN),F55,F52(PSOIEN),F525
     223        ;
    212224        L -PSRX(PSOIEN) ; Unlock record
    213225        Q
Note: See TracChangeset for help on using the changeset viewer.