Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BEHORXRT

BEHORXRT.m

Go to the documentation of this file. 
  1. BEHORXRT ;IHS/MSC/MGH - E-Prescribing receipt ;06-Sep-2013 10:42;MGH
  1.  ;;1.1;BEH COMPONENTS;**009004,009006,009007,009009,009010**;Mar 20, 2007
  1.  ;=================================================================
  1.  ; RPC: Retrieve reports for date range
  1. GETRPTS(DATA,DFN,BEHFLG,STRT,END) ;EP
  1.  S DATA=$$TMPGBL^CIAVMRPC
  1.  D CAPTURE^CIAUHFS("D REPORTS^BEHORXRT(DFN,.BEHFLG,STRT,END)",DATA,80)
  1.  S:'$D(@DATA) @DATA@(1)="No E-Prescriptions found within specified date range."
  1.  Q
  1.  ; RPC: Retrieve report
  1.  ; Entry point for OE/RR REPORT file
  1. OERRRPTS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
  1.  D GETRPTS(.ROOT,ORDFN,,ALPHA,OMEGA)
  1.  Q
  1. REPORTS(DFN,BEHFLG,STRT,END) ;
  1.  N TRANSDT,IEN,DATA,RX,PAT,STATUS
  1.  K ^TMP("BEHRX",$J) K ^TMP("BEHRX2",$J)
  1.  S TRANSDT=STRT,END=END\1+.2359
  1.  F  S TRANSDT=$O(^PS(52.51,"AC1",TRANSDT)) Q:TRANSDT=""  D
  1.  .I TRANSDT,TRANSDT'>END D
  1.  ..S IEN="" F  S IEN=$O(^PS(52.51,"AC1",TRANSDT,IEN)) Q:IEN=""  D
  1.  ...S DATA=$G(^PS(52.51,IEN,0))
  1.  ...S PAT=$P(DATA,U,2),STATUS=$P($G(^PS(52.51,IEN,0)),U,10)
  1.  ...I PAT=DFN&(STATUS=2) D SAVE(IEN,DATA)
  1.  D RESORT,REPORT
  1.  Q
  1. SAVE(IEN,DATA) ;EP
  1.  ; Generate specified report segments for a visit abstract
  1.  N RX,PHARM,RXDRUG,DRUG,RXPHARM,PHARM,PROV,TDATE
  1.  S RX=$P(DATA,U,1)
  1.  Q:RX=""
  1.  S RXDRUG=$P($G(^PSRX(RX,0)),U,6)
  1.  Q:RXDRUG=""
  1.  S DRUG=$P($G(^PSDRUG(RXDRUG,0)),U,1)
  1.  S RXPHARM=$P($G(^PSRX(RX,999999921)),U,4)
  1.  Q:RXPHARM=""
  1.  S PROV=$P($G(^PSRX(RX,0)),U,4)
  1.  Q:PROV=""
  1.  S PHARM=$P($G(^APSPOPHM(RXPHARM,0)),U,1)
  1.  S TDATE=$P(TRANSDT,".",1)
  1.  S ^TMP("BEHRX",$J,PROV,RXPHARM,TDATE,RX)=TRANSDT
  1.  Q
  1. RESORT ;
  1.  N PROV,RXPHARM,TRANSDT,RX,CNT
  1.  S CNT=0
  1.  S PROV="" F  S PROV=$O(^TMP("BEHRX",$J,PROV)) Q:PROV=""  D
  1.  .S RXPHARM="" F  S RXPHARM=$O(^TMP("BEHRX",$J,PROV,RXPHARM)) Q:RXPHARM=""  D
  1.  ..S TRANSDT="" F  S TRANSDT=$O(^TMP("BEHRX",$J,PROV,RXPHARM,TRANSDT)) Q:TRANSDT=""  D
  1.  ...S CNT=0 S RX="" F  S RX=$O(^TMP("BEHRX",$J,PROV,RXPHARM,TRANSDT,RX)) Q:RX=""  D
  1.  ....S CNT=CNT+1
  1.  ....S ^TMP("BEHRX2",$J,PROV,RXPHARM,TRANSDT)=CNT
  1.  Q
  1. REPORT ;
  1.  N PROV,RXPHARM,TRANSDT,RX,RX0,INST,HLOC,PAGE,NNAME,DNAME,LNAME,FNAME,NAME,TDATE
  1.  N ADDRESS,CITY,DTE,FIRST,IADDRESS,ICITY,IFAX,INAME,IPHONE,SNAME
  1.  S PAGE=0,FIRST=1,NNAME="UNKNOWN"
  1.  S (INAME,IADDRESS,ICITY,IPHONE,IFAX)=""
  1.  D HDR
  1.  S PROV="" F  S PROV=$O(^TMP("BEHRX",$J,PROV)) Q:PROV=""  D
  1.  .;I FIRST=0 D FOOTER,HDR
  1.  .S NNAME=$P($G(^VA(200,PROV,0)),U,1)
  1.  .S RXPHARM="" F  S RXPHARM=$O(^TMP("BEHRX",$J,PROV,RXPHARM)) Q:RXPHARM=""  D
  1.  ..;I FIRST=0 D FOOTER,HDR
  1.  ..D PHARM
  1.  ..S TRANSDT="" F  S TRANSDT=$O(^TMP("BEHRX",$J,PROV,RXPHARM,TRANSDT)) Q:TRANSDT=""  D
  1.  ...I FIRST=0 D FOOTER,HDR
  1.  ...S CNT=$G(^TMP("BEHRX2",$J,PROV,RXPHARM,TRANSDT))
  1.  ...S DTE=$$FMTE^XLFDT(TRANSDT)
  1.  ...W !,CNT_" prescription(s) were sent on: "_DTE
  1.  ...W !,"Prescriptions were sent electronically and securely to:"
  1.  ...W !,$$CJ^XLFSTR(SNAME,IOM)
  1.  ...W !,$$CJ^XLFSTR(ADDRESS,IOM)
  1.  ...W !,$$CJ^XLFSTR(CITY,IOM)
  1.  ...W !,"The prescription(s) sent were:",!
  1.  ...W !,"MEDICATION",?50,"SENT"
  1.  ...S RX="" F  S RX=$O(^TMP("BEHRX",$J,PROV,RXPHARM,TRANSDT,RX)) Q:RX=""  D
  1.  ....I FIRST=1 S FIRST=0
  1.  ....S RX0=$G(^PSRX(RX,0))
  1.  ....S HLOC=$P(RX0,U,5)
  1.  ....S INST=$$GET1^DIQ(44,HLOC,3,"I")
  1.  ....D INST
  1.  ....S DRUG=$P(RX0,U,6),DNAME=$P($G(^PSDRUG(DRUG,0)),U,1)
  1.  ....S TDATE=$G(^TMP("BEHRX",$J,PROV,RXPHARM,TRANSDT,RX))
  1.  ....W !,DNAME,?50,$$FMTE^XLFDT(TDATE)
  1.  D FOOTER
  1.  Q
  1. PHARM ;Get the data for the pharmacy
  1.  S SNAME=$$VAL^XBDIQ1(9009033.9,RXPHARM,.1)
  1.  S ADDRESS=$$VAL^XBDIQ1(9009033.9,RXPHARM,1.1)_" "_$$VAL^XBDIQ1(9009033.9,RXPHARM,1.2)
  1.  S CITY=$$VAL^XBDIQ1(9009033.9,RXPHARM,1.3)_" "_$$VAL^XBDIQ1(9009033.9,RXPHARM,1.4)_" "_$$VAL^XBDIQ1(9009033.9,RXPHARM,1.5)
  1.  Q
  1. INST ;Get the data for the institution
  1.  S INAME=$$GET1^DIQ(4,INST,.01)
  1.  S IADDRESS=$$GET1^DIQ(4,INST,1.01)  ;Street Address 1
  1.  S ICITY=$$GET1^DIQ(4,INST,1.03)_", "_$$GET1^DIQ(4,INST,.02)_"  "_$$GET1^DIQ(4,INST,1.04)
  1.  S IPHONE=$$GET1^DIQ(9999999.06,INST,.13)
  1.  S IFAX=$$GET^XPAR("ALL","APSP AUTO RX FAXED FROM NUMBER")
  1.  Q
  1.  ; Start new page and output header if exceed line count
  1. HDR S CNT=$G(CNT,1),PAGE=PAGE+1
  1.  W @IOF
  1.  ;W #
  1.  W !,$$CJ^XLFSTR("RECEIPT",IOM)
  1.  W !,$$CJ^XLFSTR("E-Prescription Transmission Summary",IOM),!!
  1.  S NAME=$P($G(^DPT(DFN,0)),U,1)
  1.  S LNAME=$P(NAME,",",1),FNAME=$P(NAME,",",2)
  1.  S NAME=FNAME_" "_LNAME
  1.  W !,$$CJ^XLFSTR(NAME,IOM),!
  1.  Q
  1.  N I
  1.  W !!!,"Important Note: This is the summary of your medications"
  1.  W !,"you will be receiving from your pharmacy.  You do not have"
  1.  W !,"to present this slip at your pharmacy in order to pick up your"
  1.  W !,"prescription(s), but sharing this slip with the pharmacist can"
  1.  W !,"help to  ensure that you get all of the medicines that have been"
  1.  W !,"prescribed for you",!!
  1.  W !,"To the Pharmacist:",!
  1.  W !,"Prescriptions for the medications listed above were sent to your"
  1.  W !,"pharmacy via the Surescripts network. Please look for these"
  1.  W !,"prescriptions in your computer's electronic prescriptions queue"
  1.  W !,"and/or your fax machine.",!!
  1.  W !,$$CJ^XLFSTR(NNAME,IOM)
  1.  W !,$$CJ^XLFSTR(INAME,IOM)
  1.  W !,$$CJ^XLFSTR(IADDRESS,IOM)
  1.  W !,$$CJ^XLFSTR(ICITY,IOM)
  1.  W !,$$CJ^XLFSTR("Phone: "_IPHONE,IOM)
  1.  W !,$$CJ^XLFSTR("Fax: "_IFAX,IOM)
  1.  S PAGE=PAGE+1
  1.  W !!,$$REPEAT^XLFSTR("=",80),!
  1.  F I=$Y:1:IOSL-8 W !
  1.  Q
  1.  ; Return XML array for a list of prescriptions
  1. RECXML(DATA,RXARY,DFN) ;EP-
  1.  N DAT,ID,CNT,PNM,RX,LP
  1.  S DATA=$$TMPGBL^CIAVMRPC
  1.  K @DATA
  1.  S CNT=0
  1.  S PNM=$$GET1^DIQ(2,DFN,.01)
  1.  S PNM=$P(PNM,",",2)_" "_$P(PNM,",")
  1.  D ADD("<?xml version=""1.0"" ?>")
  1.  D ADD($$TAG("Transactions",0))
  1.  D ADD($$TAG("PatientName",2,PNM))
  1.  D BLDPT^BEHORXF2(DFN,"")
  1.  D BLDPTADD^BEHORXF2(DFN)
  1.  D DATA^BEHORXF2(DFN)
  1.  S LP=0 F  S LP=$O(RXARY(LP)) Q:'LP  D
  1.  .S RX=$$GETPSIFN^BEHORXFN(RXARY(LP))
  1.  .S ID=+RXARY(LP)
  1.  .D:RX RECEIPT(RX,ID)
  1.  .;D:RX ADDXML(RX)
  1.  D ADD($$TAG("Transactions",1))
  1.  Q
  1. RECEIPT(RX,ORDID) ;EP
  1.  N RXINFO,PRVIEN,QTY,QTYW
  1.  K ^TMP("PS",$J)
  1.  D OEL^PSOORRL(DFN,RX)
  1.  S RXINFO=$G(^TMP("PS",$J,0)),$P(RXINFO,U,2)=$P($G(^("RXN",0)),U)
  1.  S $P(RXINFO,U,9)=$TR($G(^TMP("PS",$J,"P",0)),U,"~")
  1.  S PRVIEN=+$P(RXINFO,U,9)
  1.  S $P(RXINFO,U,10)=RX_"R;O"
  1.  S $P(RXINFO,U,13)=$$GET1^DIQ(59,+$$LOC^APSPFNC2(+ORDID),.01)
  1.  S $P(RXINFO,U,14)=$$NDCVAL^APSPFUNC(RX)
  1.  D ADDXML(RX)
  1.  Q
  1. ADDXML(RX) ;EP-
  1.  N PHMI,INI,PFN,LNAME,DRG,RRIEN,SSNUM,QTY,QTYW,DRUG,DISPU,RXDIV
  1.  S PFN=9009033.9
  1.  S PHMI=$$GET1^DIQ(52,RX,9999999.24,"I")
  1.  S INI=$$GET1^DIQ(44,$$GET1^DIQ(52,RX,5,"I"),3,"I")
  1.  I INI="" D
  1.  .S RXDIV=$$GET1^DIQ(52,RX,20,"I")
  1.  .S INI=$$GET1^DIQ(44,$$GET1^DIQ(9009033,RXDIV,317,"I"),3,"I")
  1.  S DRUG=$$GET1^DIQ(52,RX,6,"I")
  1.  S DISPU=$$GET1^DIQ(50,DRUG,14.5)
  1.  D ADD($$TAG("Transaction",0))
  1.  D ADD($$TAG("Chronic",2,$$GET1^DIQ(52,RX,9999999.02)))
  1.  D ADD($$TAG("DAW",2,$S($$GETDAW^BEHORXFN(ORDID):"Yes",1:"No")))
  1.  D ADD($$TAG("DaysSupply",2,$P(RXINFO,U,7)))
  1.  D ADD($$TAG("DrugName",2,$P(RXINFO,U)))
  1.  D ADD($$TAG("IndCode",2,$P($$GETIND^BEHORXFN(ORDID),"~")))
  1.  D ADD($$TAG("IndText",2,$P($$GETIND^BEHORXFN(ORDID),"~",2)))
  1.  D ADD($$TAG("Instruct",2,$$RXINSTR^BEHORXF1()))
  1.  D ADD($$TAG("NotesToPharmacist",2,$$ORDCOM^BEHORXF1(ORDID)))
  1.  S RRIEN=$$VALUE^ORCSAVE2(+ORDID,"SSRREQIEN")
  1.  S SSNUM=$$GET1^DIQ(9009033.91,RRIEN,.1)
  1.  D ADD($$TAG("EnteredBy",2,$$GET1^DIQ(100,ORDID,3)))
  1.  D ADD($$TAG("OrderLocation",2,$$GET1^DIQ(100,ORDID,6)))
  1.  D ADD($$TAG("OrderableItem",2,$$GET1^DIQ(101.43,$$VALUE^ORCSAVE2(ORDID,"ORDERABLE"),.01)))
  1.  D ADD($$TAG("IssueDate",2,$$FMTE^XLFDT($P(RXINFO,U,5),9)))
  1.  D ADD($$TAG("PharmSite",2,$P(RXINFO,U,13)))  ;name
  1.  D ADD($$TAG("Provider",2,$P($P(RXINFO,U,9),"~",2)))
  1.  D PROV^BEHORXF2(PRVIEN)
  1.  S QTY=$P(RXINFO,U,8),QTYW=$$WRDFMT^APSPFNC7(QTY)
  1.  ;D ADD($$TAG("Quantity",2,QTY_"("_QTYW_")"))
  1.  ; DKA 2013-02-25 artf13536 Don't add parentheses if Quantity-In-Words is blank for decimal value.
  1.  D ADD($$TAG("Quantity",2,QTY_$S(QTYW="":"",1:"("_QTYW_")")_" "_DISPU))
  1.  D ADD($$TAG("Refills",2,$P(RXINFO,U,4)))
  1.  D ADD($$TAG("RxNorm",2,$$GETRXNRM^BEHORXFN(ORDID,RX)))
  1.  D ADD($$TAG("ProcessState",2,$$PSTATE^BEHORXFN(RX)))
  1.  D ADD($$TAG("NeedsReason",2,$$GETNDRSN^BEHORXF1($$PSTATE^BEHORXFN(RX))))
  1.  I PHMI D PHARM2(PHMI)
  1.  I INI D INST2(INI)
  1.  D ADD($$TAG("DEA",2,$$GET1^DIQ(50,$$GET1^DIQ(52,RX,6,"I"),3)))
  1.  D ADD($$TAG("Provider",2,$$GET1^DIQ(52,RX,4)))
  1.  D ADD($$TAG("Date_Time",2,$$XMTDATE(RX)))
  1.  S DRG=$$GET1^DIQ(52,RX,6,"I")
  1.  S LNAME=""
  1.  S LNAME=$$GET1^DIQ(50,DRG,9999999.352)
  1.  D ADD($$TAG("TransmittedDrugName",2,$S(LNAME'="":LNAME,1:$$GET1^DIQ(52,RX,6))))
  1.  D ADD($$TAG("MessageId",2,SSNUM))
  1.  D ADD($$TAG("Transaction",1))
  1.  Q
  1. INST2(INI) ;Enter Institution data
  1.  D ADD($$TAG("InstitutionName",2,$$GET1^DIQ(4,INI,.01)))
  1.  D ADD($$TAG("InstitutionAddr1",2,$$GET1^DIQ(4,INI,1.01)))
  1.  D ADD($$TAG("InstitutionCity",2,$$GET1^DIQ(4,INI,1.03)))
  1.  D ADD($$TAG("InstitutionState",2,$$GET1^DIQ(4,INI,.02)))
  1.  D ADD($$TAG("InstitutionZip",2,$$GET1^DIQ(4,INI,1.04)))
  1.  D ADD($$TAG("InstitutionFax",2,$$GET^XPAR("ALL","APSP AUTO RX FAXED FROM NUMBER")))
  1.  D ADD($$TAG("InstitutionPhone",2,$$GET1^DIQ(9999999.06,INI,.13)))
  1.  Q
  1. PHARM2(PHMI) ;Add pharmacy data
  1.  N PFN
  1.  S PFN=9009033.9
  1.  D ADD($$TAG("PharmacyName",2,$$GET1^DIQ(PFN,PHMI,.1)))
  1.  D ADD($$TAG("PharmacyAddr1",2,$$GET1^DIQ(PFN,PHMI,1.1)))
  1.  D ADD($$TAG("PharmacyAddr2",2,$$GET1^DIQ(PFN,PHMI,1.2)))
  1.  D ADD($$TAG("PharmacyCity",2,$$GET1^DIQ(PFN,PHMI,1.3)))
  1.  D ADD($$TAG("PharmacyState",2,$$GET1^DIQ(PFN,PHMI,1.4)))
  1.  D ADD($$TAG("PharmacyZip",2,$$GET1^DIQ(PFN,PHMI,1.5)))
  1.  D ADD($$TAG("PharmacyPhone",2,$$GET1^DIQ(PFN,PHMI,2.1)))
  1.  Q
  1.  ; Return formatted transmission date/time
  1. XMTDATE(RX) ;EP-
  1.  N IEN,TDT
  1.  S IEN=$O(^PS(52.51,"B",RX,0))
  1.  Q $$GET1^DIQ(52.51,IEN,3)
  1.  ; Add data to array
  1. ADD(VAL) ;EP-
  1.  S CNT=CNT+1
  1.  S @DATA@(CNT)=VAL
  1.  Q
  1.  ; Returns formatted tag
  1.  ; Input: TAG - Name of Tag
  1.  ;        TYPE - (-1) = empty 0 =start <tag>   1 =end </tag>  2 = start -VAL - end
  1.  ;        VAL - data value
  1. TAG(TAG,TYPE,VAL) ;EP -
  1.  S TYPE=$G(TYPE,0)
  1.  S:$L($G(VAL)) VAL=$$SYMENC^MXMLUTL(VAL)
  1.  I TYPE<0 Q "<"_TAG_"/>"  ;empty
  1.  E  I TYPE=1 Q "</"_TAG_">"
  1.  E  I TYPE=2 Q "<"_TAG_">"_$G(VAL)_"</"_TAG_">"
  1.  Q "<"_TAG_">"