Changeset 323 for ccr

Timestamp:

Jan 12, 2009, 12:04:14 AM (16 years ago)

Author:

Sam Habiel

Message:

Meds for RPMS, CCRMEDS6, continued...

File:

• ccr/trunk/p/CCRMEDS6.m (modified) (6 diffs)

ccr/trunk/p/CCRMEDS6.m

@@ -1 @@
-CCRMEDS6 ; WV/CCDCCR/SMH - Meds from RPMS;01/10/09
+CCRMEDS6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
  ;;0.1;CCDCCR;;JUL 16,2008;
  ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
@@ -34 +34 @@
  ; This API has been developed by Medsphere for IHS for getting
  ; Medications from RPMS. It has most of what we need.
+ ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
  ; -- ARRAYNAME is passed by name (required)
  ; -- DFN is passed by value (required)
@@ -50 +51 @@
  N MEDCNT S MEDCNT=0 ; Med Count
  ; The next line is a super line. It goes through the array return
- ; and if the first character is a ~, it grabs the line.
+ ; and if the first characters are ~OP, it grabs the line.
+ ; This means that line is for a dispensed Outpatient Med.
  ; That line has the metadata about the med that I need.
  ; The next lines, however many, are the med and the sig.
  ; I won't be using those because I have to get the sig parsed exactly.
- N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J))="~" S MEDCNT=MEDCNT+1 S MED(MEDCNT)=MEDS1(J)
+ N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MED(MEDCNT)=MEDS1(J)
  S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; this is the variable map
  S @MEDMAP@(0)=0 ; Initial count of meds
@@ -126 +128 @@
  . ; -- Conc is 2 concatenated with 3
  . ; 
- . N MEDIEN S MEDIEN=$P(MED(6),U)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
- . ; Units, concentration, etc, come from another call
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
- . ; NDF Entry IEN, and VA Product Name
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
- . ; Documented in the same manual.
- . D NDF^PSS50(MEDIEN,,,,,"CONC")
- . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
- . N CONCDATA
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
- . ; and this will crash the call. So...
- . I NDFIEN="" S CONCDATA=""
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
- . S @MAP@("MEDQUANTITYVALUE")=MED(7)
- . ; Oddly, there is no easy place to find the dispense unit.
- . ; It's not included in the original call, so we have to go to the drug file.
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
- . ; Node 14.5 is the Dispense Unit
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . ; *** If Drug is not matched to NDF, then VA Product will be "" ***
+ . ;
+ . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
+ . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
+ . I +VAPROD D
+ . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
+ . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
+ . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
+ . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
+ . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
+ . E  D
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+ . . S @MAP@("MEDFORMTEXT")=""
+ . . S @MAP@("MEDCONCVALUE")=""
+ . . S @MAP@("MEDCONCUNIT")=""
+ . ; End Strengh/Conc stuff
+ . ;
+ . ; Quantity is in the prescription, field 7
+ . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
+ . ; Dispense unit is in the drug file, field 14.5
+ . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
  . ;
  . ; --- START OF DIRECTIONS ---
  . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
  . ; we want the compoenents.
- . ; It's in node 6 of ^PSRX(IEN)
- . ; So, here we go again
- . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
- . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
- . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
- . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
- . ;
- . N DIRNUM S DIRNUM=0 ; Sigline number
- . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
- . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
+ . ; It's in multiple 113 in the Prescription File (52)
+ . ; #.01 DOSAGE ORDERED [1F]                   "20"
+ . ; #1 DISPENSE UNITS PER DOSE [2N]    "1"
+ . ; #2 UNITS [3P:50.607]                               "MG"
+ . ; #3 NOUN [4F]                                               "TABLET"
+ . ; #4 DURATION [5F]                                   "10D"
+ . ; #5 CONJUNCTION [6S]                                "AND"
+ . ; #6 ROUTE [7P:51.2]                                 "ORAL"
+ . ; #7 SCHEDULE [8F]                                   "BID"
+ . ; #8 VERB [9F]                                               "TAKE"
+ . ;
+ . ; Will use GETS^DIQ to get fields.
+ . ; Data comes out like this:
+ . ; SAMINS(52.0113,"1,23,",.01)=20
+ . ; SAMINS(52.0113,"1,23,",1)=1
+ . ; SAMINS(52.0113,"1,23,",2)="MG"
+ . ; SAMINS(52.0113,"1,23,",3)="TABLET"
+ . ; SAMINS(52.0113,"1,23,",4)="5D"
+ . ; SAMINS(52.0113,"1,23,",5)="THEN"
+ . ;
+ . N RAWDATA
+ . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA")
+ . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
+ . K RAWDATA
+ . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
+ . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
+ . ; DIRCNT is the proper Sigline numer.
+ . ; SIGDATA is the simplfied array. 
+ . F  S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM=""  D
+ . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
+ . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
- . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(8)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(.01)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=SIGDATA(2)
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(6)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(7)
  . . ; Invervals... again another call.
  . . ; In the wisdom of the original programmers, the schedule is a free text field
@@ -188 +200 @@
  . . ; to see if that schedule exists.
  . . ; That's the same thing I am going to do.
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
- . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
- . . ; So...
- . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
- . . N INTERVAL
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
- . . E  D
- . . . N SUB S SUB=$O(SCHEDATA(0))
- . . . S INTERVAL=SCHEDATA(SUB,2)
+ . . ; Search B index of 51.1 (Admin Schedule) with first abbr of schedule
+ . . N SCHEDIEN=$$FIND^DIC(51.1,,,$P(SIGDATA(7)," "),"B") 
+ . . N INTERVAL S INTERVAL="" ; Default
+ . . S:SCEHDIEN INTERVAL=$$GET1^DIQ(51.1,SCHEDIEN,2)
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
+ . . ; Duration is 10M minutes, 10H hours, 10D for Days
+ . . ; 10W for weeks, 10L for months. I smell $Select
+ . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
+ . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(4)["PRN"
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
@@ -211 +220 @@
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
  . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
- . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
+ . . ; Another confusing line; I am pretty bad:
+ . . ; If there is another entry in the FMSIG array (i.e. another line
+ . . ; in the sig), set the direction count indicator.
+ . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(5)
  . ;
  . ; --- END OF DIRECTIONS ---