Changeset 1608 for fmts/trunk/p

Timestamp:

Feb 20, 2013, 6:15:15 PM (12 years ago)

Author:

Sam Habiel

Message:

code to extract fulfillments of medications (# of times it's dispensed)

File:

• fmts/trunk/p/C0XPT3.m (modified) (10 diffs)

fmts/trunk/p/C0XPT3.m

@@ -1 @@
-C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT;2013-02-19  5:01 PM
-        ;;FILEMAN TRIPLE STORE;1.0;;;Jun 26,2012;Build 29
+C0XPT3  ;ISI/MLS,VEN/SMH -- MEDS IMPORT;2013-02-20  3:15 PM
+        ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
         ;
 MEDS(G,DFN) ; Private Proc; Extract Medication Data from a Patient's Graph
@@ -8 +8 @@
         ;
         ; 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) 
+        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.
@@ -17 +18 @@
         ; 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.
+        D 
+        . 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
@@ -35 +37 @@
         ;
         ; 5. Drug Name and Code
-        N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code") ; RxNorm Code
+        N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code"),RXN=$P(RXN,"/",$L(RXN,"/")) ; RxNorm Code
         N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name
         ;
@@ -41 +43 @@
         ;
         ; 6. Get Fill Dates
-        ;TODO.
+        N FULF ; Fulfillments
+        D GSPO^C0XGET3($NA(FULF),G,S,"sp:fulfillment")
+        ;
+        N FILLS ; Fills array. Contains every time a drug was dispensed.
+        N FILL S FILL="" F  S FILL=$O(FULF(FILL)) Q:FILL=""  D
+        . N S S S=FULF(FILL) ; New subject; subsumes above one in this loop
+        . ;
+        . ; Dispense Date
+        . N FILLDATE S FILLDATE=$$GSPO1^C0XGET3(G,S,"dcterms:date")
+        . D
+        . . N %DT,X,Y S X=FILLDATE D ^%DT S FILLDATE=Y
+        . I FILLDATE<2000000 W $EC=",U1," ; Converstion error
+        . ;
+        . S FILLS(RXN,FILLDATE,"sp:dispenseDaysSupply")=$$GSPO1^C0XGET3(G,S,"sp:dispenseDaysSupply") ; Self Explanatory?
+        . ;
+        . ; Get quantity value and unit
+        . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:value")=$$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:value")
+        . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
+        ;
+        ZWRITE:$D(FILLS) FILLS
         QUIT
-
+        ;
 MED(ISIMISC)    ;Create med order entry
         ; Input - ISIMISC(ARRAY)
@@ -67 +88 @@
         Q ISIRC
         ;
-PREP    
+PREP ;
         ;
         N EXIT
@@ -75 +96 @@
         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 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)
@@ -101 +122 @@
         Q
         ;
-CREATE  
-        D AUTO^PSONRXN  ;RX auto number
+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
+        I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q  ;pointer error
         S $P(^PSRX(0),U,3)=PSOIEN
         ;
@@ -137 +158 @@
         ;
         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),"^",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)
@@ -153 +174 @@
         ;
         ;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
+        S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX             TYPE;1 NUMBER
         D OERR,F55,F52,F525
         Q