From 20f5fb323990c858d25b0a070c5eb5a6f86d4f9c Mon Sep 17 00:00:00 2001 From: sam Date: Wed, 20 Feb 2013 00:46:41 +0000 Subject: [PATCH] Initial code for processing medications. Right now code just picks medicaitons out for a patient --- p/C0XPT0.m | 3 +- p/C0XPT3.m | 181 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 183 insertions(+), 1 deletion(-) create mode 100644 p/C0XPT3.m diff --git a/p/C0XPT0.m b/p/C0XPT0.m index b2e7422..efaa6c4 100644 --- a/p/C0XPT0.m +++ b/p/C0XPT0.m @@ -1,4 +1,4 @@ -C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-19 12:01 PM +C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-19 2:14 PM ;;1.1;FILEMAN TRIPLE STORE;; ; ; Get all graphs @@ -31,6 +31,7 @@ PROGRAPH(G) ; Process Graph (i.e. Patient) ; D VITALS(G,DFN) D PROBLEMS^C0XPT1(G,DFN) ; Extract Problems and File D ADR^C0XPT2(G,DFN) ; Extract Allergies and File + D MEDS^C0XPT3(G,DFN) ; Extract Medicaments and File ; QUIT ; diff --git a/p/C0XPT3.m b/p/C0XPT3.m new file mode 100644 index 0000000..8a1525f --- /dev/null +++ b/p/C0XPT3.m @@ -0,0 +1,181 @@ +C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT;2013-02-19 5:01 PM + ;;FILEMAN TRIPLE STORE;1.0;;;Jun 26,2012;Build 29 + ; +MEDS(G,DFN) ; Private Proc; Extract Medication Data from a Patient's Graph + ; G - Patient Graph, DFN - you should know this + K ^TMP($J,"MEDS") + D ONETYPE^C0XGET3($NA(^TMP($J,"MEDS")),G,"sp:Medication") + ; + ; For each medication (I = COUNTER; S = Medication Node as Subject) + N I,S F I=0:0 S I=$O(^TMP($J,"MEDS",I)) Q:'I S S=^(I) DO MED1(G,S) + ; + K ^TMP($J,"MEDS") + QUIT +MED1(G,S) ; Private Procedure; Process each medication in Graph. + ; G = Graph; S = Medication Description ID as subject. + ; + ; 1. Start Date; obtain and then conv to fileman format + N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,S,"sp:startDate") ; Duh! Start Date. + X "N %DT,X,Y S X=STARTDT D ^%DT S STARTDT=Y" ; New stack level for variables. + ; + ;DEBUG.ASSERT that STARTDT is greater than 1900 + I STARTDT'>2000000 S $EC=",U1," + ; + ; 2. Frequency + N FVALUE S FVALUE=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:value") + N FUNIT S FUNIT=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:unit") + ; + ; 3. Dose Quantity + ; Get value, get unit and strip the braces out. + N DOSE S DOSE=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:value") + N DUNIT S DUNIT=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:unit"),DUNIT=$TR(DUNIT,"{}") + ; + ; 4. Instructions + N INST S INST=$$GSPO1^C0XGET3(G,S,"sp:instructions") + ; + ; 5. Drug Name and Code + N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code") ; RxNorm Code + N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name + ; + W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN,! + ; + ; 6. Get Fill Dates + ;TODO. + QUIT + +MED(ISIMISC) ;Create med order entry + ; Input - ISIMISC(ARRAY) + ; Format: ISIMISC(PARAM)=VALUE + ; eg: ISIMISC("DFN")=123455 + ; + ; Output - ISIRC [return code] + ; ISIRESUL(0)=1 [if successful] + ; ISIRESUL(1)=PSOIEN [if successful] + ; + N ORZPT,PNTSTAT,PROV,PSODRUG,QTY,DAYSUPLY,REFIL,ORDCONV,RXNUM,PSOIEN + N COPIES,MLWIND,ENTERBY,UNITPRICE,PSOSITE,LOGDT,DISPDT,ISSDT,SIG + N X1,X2,EXPIRDT,STATUS,TRNSTYP,LDISPDT,FILLDT,PORDITM,REASON + N INIT,COM + ; + S ISIRC=1 + D PREP + I +ISIRC<0 Q ISIRC + D CREATE + I +ISIRC<0 Q ISIRC + S ISIRESUL(0)=1 + S ISIRESUL(1)=PSOIEN + Q ISIRC + ; +PREP + ; + N EXIT + S ORZPT=ISIMISC("DFN") ;"" ;POINTER TO PATIENT FILE (#2) + S PSODFN=ORZPT + S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53) + S PROV=ISIMISC("PROV") ;NEW PERSON FILE (#200) + S PSODRUG=ISIMISC("DRUG") ;"" ;POINTER TO DRUG FILE (#50) + S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3) + S QTY=ISIMISC("QTY") ;NUMBER ;0;7 NUMBER (Required) + S DAYSUPLY=ISIMISC("SUPPLY") ;NUMBER ; 0;8 NUMBER (Required) + S REFIL=ISIMISC("REFILL") ;NUMBER ; 0;9 NUMBER (Required) + S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS; + S COPIES=1 ;NUMBER + S MLWIND="W" ;'M' or 'W' + S ENTERBY=DUZ ;NEW PERSON FILE (#200) + S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER + S PSOSITE=ISIMISC("PSOSITE") ; OUTPATIENT SITE FILE (#59) + D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required) + S FILLDT=ISIMISC("DATE") ;DATE + S ISSDT=FILLDT ;DATE + S DISPDT=ISSDT ;DATE + S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180 + S EXPIRDT=X ; + S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7) + S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE; + S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1) + S LDISPDT=FILLDT ; 3;1 DATE + S REASON="E" ;Activity log ; SET ([E]dit) + S INIT=DUZ ;NEW PERSON FILE (#200) + S COM="Oupatient medication order." ;TEXT + S SIG=ISIMISC("SIG") ;#51,.01 + Q + ; +CREATE + D AUTO^PSONRXN ;RX auto number + I $G(PSONEW("RX #"))="" S ISIRC="-1^RX Auto number error." Q + S RXNUM=PSONEW("RX #") + ; + S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 + I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q ;pointer error + S $P(^PSRX(0),U,3)=PSOIEN + ; + S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required) + S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required) + S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2) + S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53) + S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200) + S $P(^PSRX(PSOIEN,0),"^",5)="" ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44) + S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50) + S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required) + S $P(^PSRX(PSOIEN,0),"^",8)=DAYSUPLY ;NUMBER ; 0;8 NUMBER (Required) + S $P(^PSRX(PSOIEN,0),"^",9)=REFIL ;NUMBER ; 0;9 NUMBER (Required) + S $P(^PSRX(PSOIEN,0),"^",11)=MLWIND ;'M' or 'W' + S $P(^PSRX(PSOIEN,0),"^",16)=ENTERBY ;NEW PERSON FILE (#200) + S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER + S $P(^PSRX(PSOIEN,0),"^",18)=COPIES ;COPIES + S $P(^PSRX(PSOIEN,0),"^",19)=ORDCONV ;ORDER CONVERTED 0;19 SET ['1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;] + ; + S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required) + S $P(^PSRX(PSOIEN,2),"^",2)=FILLDT ;FILL DATE + ;S $P(^PSRX(PSOIEN,2),"^",3)=PHARMACIST ; "" ; PHARMACIST ;2;3 POINTER TO NEW PERSON FILE (#200) + ;S $P(^PSRX(PSOIEN,2),"^",4)="" ; LOT # 2;4 FREE TEXT + S $P(^PSRX(PSOIEN,2),"^",5)=DISPDT ; DISPENSED DATE 2;5 DATE (Required) + S $P(^PSRX(PSOIEN,2),"^",6)=EXPIRDT ;"" ; EXPIRATION DATE + S $P(^PSRX(PSOIEN,2),"^",9)=PSOSITE ;2;9 POINTER TO OUTPATIENT SITE FILE (#59) + ; + S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE 3;1 DATE + ; + S ^PSRX(PSOIEN,"A",0)="^52.3DA^1^1" + S $P(^PSRX(PSOIEN,"A",1,0),"^",1)=LOGDT ;DATE + S $P(^PSRX(PSOIEN,"A",1,0),"^",2)=REASON ;SET + S $P(^PSRX(PSOIEN,"A",1,0),"^",3)=INIT ;NEW PERSON FILE (#200) + S $P(^PSRX(PSOIEN,"A",1,0),"^",4)=0 ;NUMBER - RX REFERENCE + S $P(^PSRX(PSOIEN,"A",1,0),"^",5)="ISI automated entry." ;TEXT + ; + S ^PSRX(PSOIEN,"OR1")=PORDITM ;PHARMACY ORDERABLE ITEM FILE (#50.7) + ; + S $P(^PSRX(PSOIEN,"POE"),"^",1)=1 ; POE RX POE;1 SET ['1' FOR YES;] + ; + S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required) medication instruction DIC(51) + S $P(^PSRX(PSOIEN,"SIG"),"^",2)=0 ;OERR SIG (SET: 0 for NO; 1 for YES) + ; + S $P(^PSRX(PSOIEN,"STA"),"^",1)=STATUS ;STA;1 SET (Required) ; '0' FOR ACTIVE; + ; + ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1) + S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER + D OERR,F55,F52,F525 + Q + ; +OERR ;UPDATES OR1 NODE + ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL + S $P(^PSRX(PSOIEN,"OR1"),"^",2)="" + S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W" + D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO) +F55 ; - File data into ^PS(55) + ;S PSODFN=DFN + S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" + F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) + 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) + S ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)="" + K PSOX1 + Q +F52 ;; - Re-indexing file 52 entry + K DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK + Q + ; +F525 ;UPDATE SUSPENSE FILE + Q:$G(^PSRX(PSOIEN,"STA"))'=5 + S DA=PSOIEN,X=PSOIEN,FDT=$P($G(^PSRX(PSOIEN,2)),"^",2),TYPE=$P($G(^PSRX(PSOIEN,0)),"^",11) + 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 + Q + ;