Changeset 1609 for fmts/trunk/p


Ignore:
Timestamp:
Feb 21, 2013, 7:57:31 PM (12 years ago)
Author:
Sam Habiel
Message:

Medications: Can now add a fake prescription to the record

Location:
fmts/trunk/p
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • fmts/trunk/p/C0XGET3.m

    r1604 r1609  
    1 C0XGET3 ; VEN/SMH - Sam's Getters... let's try to make them simple ;2013-02-04  12:00 PM
     1C0XGET3 ; VEN/SMH - Sam's Getters... let's try to make them simple ;2013-02-20  11:50 AM
    22 ;;1.1;FILEMAN TRIPLE STORE;
    33 ;
    … …  
    3333 Q:$L(EP) $$GSPO1(G,O,EP) ; if we have an extended predicate, recurse
    3434 Q ^C0X(201,O,0) ; this is the end point of the recursion.
     35 ;
     36GSPO(R,G,S,P) ; Public Proc; Get Objects for a Graph/Subject/Predicate combination
     37 ; Supports forward relational navigation for predicates using "." as separator
     38 ; R is global style RPC reference
     39 ; Extended Predicates are assumed to have only one object
     40 ; This routine doesn't process multiple objects for the extended predicate.
     41 N EP S EP=$P(P,".",2,99) ; Extended Predicate
     42 S P=$P(P,".") ; Predicate becomes the first piece
     43 N O S O=""
     44 F  S O=$O(^C0X(101,"GSPO",$$IEN(G),$$IEN(S),$$IEN(P),O)) Q:O=""  D  ; For each object
     45 . I $L(EP) D  ; If we have an extended predicate...
     46 . . I EP="*" N P S P="" F  S P=$O(^C0X(101,"GSPO",$$IEN(G),$$IEN(O),P)) Q:P=""  D  ; If all predicates (EP=*) for each predicate
     47 . . . S @R@(O,$$NSP^C0XUTIL(P))=$$GSPO1(G,O,P) ; Return (Object, namespaced predicate)=value
     48 . . E  S @R@(O)=$$GSPO1(G,O,EP)  ; If Extended Predicate, resolve the predicate to get ultimate object
     49 . E  S @R@(O)=^C0X(201,O,0) ; Otherwise, just return the object
     50 QUIT

  • fmts/trunk/p/C0XPT0.m

    r1607 r1609  
    1 C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-19  2:14 PM
     1C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-21  4:52 PM
    22 ;;1.1;FILEMAN TRIPLE STORE;;
    33 ;
    … …  
    55 NEW RETURN
    66 DO GRAPHS^C0XGET1(.RETURN) ; TODO: Return could be a global due to large data.
    7  N I S I="" F  S I=$O(RETURN(I)) Q:I=""  D  ; For each IEN
    8  . N G S G=""  F  S G=$O(RETURN(I,G)) Q:G=""  D  ; For each graph tied to IEN
     7 N C0XI S C0XI="" F  S C0XI=$O(RETURN(C0XI)) Q:C0XI=""  D  ; For each IEN
     8 . N G S G=""  F  S G=$O(RETURN(C0XI,G)) Q:G=""  D  ; For each graph tied to IEN
    99 . . D PROGRAPH(G) ; Process Graph
    1010 QUIT

  • fmts/trunk/p/C0XPT3.m

    r1608 r1609  
    1 C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT;2013-02-20  3:15 PM
     1C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-02-21  5:05 PM
    22        ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
    33        ;
    … …  
    88        ;
    99        ; For each medication (I = COUNTER; S = Medication Node as Subject)
    10         N I,S F I=0:0 S I=$O(^TMP($J,"MEDS",I)) Q:'I  S S=^(I) DO MED1(G,S)
    11         ;
     10        N C0XI,S F C0XI=0:0 S C0XI=$O(^TMP($J,"MEDS",C0XI)) Q:'C0XI  S S=^(C0XI) DO MED1(G,S,DFN)
    1211        K ^TMP($J,"MEDS")
    1312        QUIT
    1413        ;
    15 MED1(G,S) ; Private Procedure; Process each medication in Graph.
     14MED1(G,S,DFN) ; Private Procedure; Process each medication in Graph.
    1615        ; G = Graph; S = Medication Description ID as subject.
    1716        ;
    … …  
    6261        . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
    6362        ;
    64         ZWRITE:$D(FILLS) FILLS
     63        ; ZWRITE:$D(FILLS) FILLS
     64        ;
     65        D
     66        . N FILDT,FILQTY,FILDAYS
     67        . S FILDT=$O(FILLS(RXN,""))
     68        . I FILDT S FILQTY=FILLS(RXN,FILDT,"sp:quantityDispensed.sp:value"),FILDAYS=FILLS(RXN,FILDT,"sp:dispenseDaysSupply")
     69        . E  S (FILQTY,FILDAYS)=""
     70        . D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS)
     71        ;
    6572        QUIT
     73PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS) ;
     74        N ORZPT,PSODFN S (ORZPT,PSODFN)=DFN  ;"" ;POINTER TO PATIENT FILE (#2)
     75        N PNTSTAT S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
     76        N PROV S PROV=$$NP^C0XPT0() ;NEW PERSON FILE (#200)
     77        N PSODRUG S PSODRUG=94558 ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN
     78        S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
     79        N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required)
     80        N DAYSUPLY S DAYSUPLY=FILDAYS ;NUMBER ; 0;8 NUMBER (Required);
     81        N REFIL S REFIL=0 ;NUMBER ; 0;9 NUMBER (Required)
     82        N ORDCONV S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
     83        N COPIES S COPIES=1 ;NUMBER
     84        N MLWIND S MLWIND="W" ; Mail/Window: 'M' or 'W'
     85        N ENTERBY S ENTERBY=.5 ;NEW PERSON FILE (#200) - POSTMASTER
     86        N UNITPRICE S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
     87        N PSOSITE S PSOSITE=$O(^PS(59,0)) ; OUTPATIENT SITE FILE (#59); get first one
     88        N %,LOGDT D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
     89        N FILLDT S FILLDT=FILDT ;DATE; First fill date from our data.
     90        N ISSDT S ISSDT=FILLDT ;DATE
     91        N DISPDT S DISPDT=ISSDT ;DATE
     92        N X D
     93        . N X1,X2
     94        . S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
     95        N EXPIRDT S EXPIRDT=X ;
     96        N PORDITM S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
     97        N STATUS S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
     98        N TRNSTYP S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
     99        N LDISPDT S LDISPDT=FILLDT ;    3;1 DATE
     100        N REASON S REASON="E" ;Activity log ; SET ([E]dit)
     101        N INIT S INIT=DUZ ;NEW PERSON FILE (#200)
     102        N COM S COM="Oupatient medication order." ;TEXT
     103        N SIG S SIG=INST ;#51,.01
    66104        ;
    67 MED(ISIMISC)    ;Create med order entry
    68         ; Input - ISIMISC(ARRAY)
    69         ; Format:  ISIMISC(PARAM)=VALUE
    70         ;     eg:  ISIMISC("DFN")=123455
     105CREATE ; fall through
    71106        ;
    72         ; Output - ISIRC [return code]
    73         ;          ISIRESUL(0)=1 [if successful]
    74         ;          ISIRESUL(1)=PSOIEN [if successful]
     107        N PSONEW
     108        D AUTO^PSONRXN ;RX auto number
     109        I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on!
     110        N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again...
    75111        ;
    76         N ORZPT,PNTSTAT,PROV,PSODRUG,QTY,DAYSUPLY,REFIL,ORDCONV,RXNUM,PSOIEN
    77         N COPIES,MLWIND,ENTERBY,UNITPRICE,PSOSITE,LOGDT,DISPDT,ISSDT,SIG
    78         N X1,X2,EXPIRDT,STATUS,TRNSTYP,LDISPDT,FILLDT,PORDITM,REASON
    79         N INIT,COM
     112        L +^PSRX(0):0 ; Lock zero node while we get the record.
     113        N PSOIEN S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 ; Next available IEN
     114        I $D(^PSRX(PSOIEN)) S $EC=",U1," ; Next number not available. File issue.
     115        S $P(^PSRX(0),U,3)=PSOIEN ; Reset next available number.
     116        S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
     117        L -^PSRX(0) ; Unlock zero node, we now got it
    80118        ;
    81         S ISIRC=1
    82         D PREP
    83         I +ISIRC<0 Q ISIRC
    84         D CREATE
    85         I +ISIRC<0 Q ISIRC
    86         S ISIRESUL(0)=1
    87         S ISIRESUL(1)=PSOIEN
    88         Q ISIRC
    89         ;
    90 PREP ;
    91         ;
    92         N EXIT
    93         S ORZPT=ISIMISC("DFN") ;"" ;POINTER TO PATIENT FILE (#2)
    94         S PSODFN=ORZPT
    95         S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
    96         S PROV=ISIMISC("PROV") ;NEW PERSON FILE (#200)
    97         S PSODRUG=ISIMISC("DRUG") ;"" ;POINTER TO DRUG FILE (#50)
    98         S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
    99         S QTY=ISIMISC("QTY") ;NUMBER ;0;7 NUMBER (Required)
    100         S DAYSUPLY=ISIMISC("SUPPLY") ;NUMBER ; 0;8 NUMBER (Required)
    101         S REFIL=ISIMISC("REFILL") ;NUMBER ; 0;9 NUMBER (Required)
    102         S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
    103         S COPIES=1 ;NUMBER
    104         S MLWIND="W" ;'M' or 'W'
    105         S ENTERBY=DUZ ;NEW PERSON FILE (#200)
    106         S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
    107         S PSOSITE=ISIMISC("PSOSITE") ; OUTPATIENT SITE FILE (#59)
    108         D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
    109         S FILLDT=ISIMISC("DATE") ;DATE
    110         S ISSDT=FILLDT ;DATE
    111         S DISPDT=ISSDT ;DATE
    112         S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
    113         S EXPIRDT=X ;
    114         S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
    115         S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
    116         S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
    117         S LDISPDT=FILLDT ;    3;1 DATE
    118         S REASON="E" ;Activity log ; SET ([E]dit)
    119         S INIT=DUZ ;NEW PERSON FILE (#200)
    120         S COM="Oupatient medication order." ;TEXT
    121         S SIG=ISIMISC("SIG") ;#51,.01
    122         Q
    123         ;
    124 CREATE ;
    125         D AUTO^PSONRXN ;RX auto number
    126         I $G(PSONEW("RX #"))="" S ISIRC="-1^RX Auto number error." Q
    127         S RXNUM=PSONEW("RX #")
    128         ;
    129         S PSOIEN=$P($G(^PSRX(0)),"^",3)+1
    130         I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q  ;pointer error
    131         S $P(^PSRX(0),U,3)=PSOIEN
    132         ;
    133         S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
     119        L +^PSRX(PSOIEN):0 ; Lock record node
    134120        S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required)
    135121        S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2)
    … …  
    175161        ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE   IB ACTION TYPE FILE (#350.1)
    176162        S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX             TYPE;1 NUMBER
    177         D OERR,F55,F52,F525
     163        D OERR(PSOIEN),F55,F52,F525
     164        L -PSRX(PSOIEN) ; Unlock record
    178165        Q
    179166        ;
    180 OERR    ;UPDATES OR1 NODE
     167OERR(PSOIEN)    ;UPDATES OR1 NODE
    181168        ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL
    182169        S $P(^PSRX(PSOIEN,"OR1"),"^",2)=""
     170        N PSXRXIEN,STAT,PSSTAT,COMM,PSNOO
    183171        S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W"
    184172        D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO)
     173        QUIT
    185174F55     ; - File data into ^PS(55)
    186175        ;S PSODFN=DFN
    … …  
    188177        F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1))
    189178        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)
    190         S ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
     179        S:$P($G(^PSRX(PSOIEN,2)),"^",6) ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
    191180        K PSOX1
    192181        Q
Note: See TracChangeset for help on using the changeset viewer.