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