PSOERX1C ;ALB/BWF - eRx Utilities ; 11/27/2019 10:20am
;;7.0;OUTPATIENT PHARMACY;**467,520,527,508,551,581,617,646,700**;DEC 1997;Build 261
;
Q
; select an item
PRINT(PSOIEN,OP) ;
N %ZIS,POP
S OP=$G(OP)
D FULL^VALM1
S VALMBCK="R"
S %ZIS="Q",%ZIS("B")=$G(PSOPROP) D ^%ZIS Q:POP
; if queuing, queue it and quit.
I $D(IO("Q")) D Q
.S ZTSAVE("PSOIEN")="",ZTSAVE("OP")="",ZTSAVE("VALMAR")="",ZTSAVE("VALMEVL")=""
.S ZTRTN="PRINTQ^PSOERX1C(PSOIEN,OP)",ZTDESC="eRx Print" D ^%ZTLOAD
.K ZTSAVE,ZTRTN
.D INIT^PSOERX1
.D TERM^VALM0
D PRINTQ(PSOIEN,OP)
D TERM^VALM0
D INIT^PSOERX1
Q
; fall through if no queueing
PRINTQ(PSOIEN,OP) ;
N %ZIS,POP,RXDAT,PHARIEN,PRVIEN,PATIEN,PHARDAT,PRVDAT,PATDAT,PSOIENS,PHNM,PHAD1,PHAD2,PHCTY,LINE,LOOP,PROHIBIT,ERXWDATE
N PHST,PHZIP,PHNCP,PHTEL,PRFNM,PRLNM,PRMNM,PRAD1,PRAD2,PRCTY,PRST,PRZIP,PRNPI,PRDEA,PRSTL,LTXT,MTYPE,NEWRXIEN,ERXEFFDT,PHW,SGLOOP
N PRTEL,PRFAX,PRSUPER,PRAGNT,PTLNM,PTFNM,PTMNM,PTAD1,PTAD2,PTCTY,PTST,PTZIP,PTDOB,PTGEN,PTHPHON,S2017,MEDIEN,R2017
N PHARIENS,PATIENS,PRVIENS,PTSSN,PRAGNTFN,PRAGNTMN,PRAGNTLN,TYPE,VALUE,SIEN,REFILL,IENS,CANREQ,CANRES,ERXDSUB,EXSTATUS
N CHGMESRI,CHGMESRQ,RESPVAL,DRUGCODE
S OP=$G(OP,"")
S PSOIEN=$G(PSOIEN)
I '$G(PSOIEN) D
.I $D(RXOR) S PSOIEN=$$CHKERX^PSOERXU1($P(RXOR,U,2)) Q:PSOIEN
.I $D(OR0) S PSOIEN=$$CHKERX^PSOERXU1(OR0)
Q:'$G(PSOIEN)
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
S CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
S CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
S RESPVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
I MTYPE="CN"!(MTYPE="RE")!(MTYPE="IE") D
.S CANRES=PSOIEN
.S CANREQ=$$GETREQ^PSOERXU2(PSOIEN)
.I $G(CANREQ) D
..S NEWRXIEN=$$RESOLV^PSOERXU2(CANREQ)
..; if there is no NewRx related to this request, pull the data from the cancel request itself.
..I '$P(NEWRXIEN,U) S NEWRXIEN=$G(CANREQ)
I MTYPE="CA"!(MTYPE="RR") D
.S CANREQ=PSOIEN,CANRES=$$GETRESP^PSOERXU2(CANREQ)
.S NEWRXIEN=$$RESOLV^PSOERXU2(CANREQ)
.I '$P(NEWRXIEN,U) S NEWRXIEN=$G(CANREQ)
; if we found the newrxien because of a different message type, reset PSOIEN to pull rx info from the newrx.
S S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
I S2017 D
.I MTYPE'="RE" D
..S MEDIEN=$O(^PS(52.49,PSOIEN,311,"C","P",0))
.I MTYPE="RE" D
..S MEDIEN=$O(^PS(52.49,PSOIEN,311,"C","MR",0))
S PSOIENS=PSOIEN_","
I $D(ZTQUEUED) S ZTREQ="@"
U IO
D GETS^DIQ(52.49,PSOIENS,".04;.08;2.1;2.5","I","RXDAT")
S PHARIEN=$G(RXDAT(52.49,PSOIENS,2.5,"I"))
S:PHARIEN PHARIENS=PHARIEN_","
S PRVIEN=$G(RXDAT(52.49,PSOIENS,2.1,"I"))
S:PRVIEN PRVIENS=PRVIEN_","
S PATIEN=$G(RXDAT(52.49,PSOIENS,.04,"I"))
S:PATIEN PATIENS=PATIEN_","
I $D(PHARIENS) D GETS^DIQ(52.47,PHARIENS,"**","E","PHARDAT")
I $D(PRVIENS) D GETS^DIQ(52.48,PRVIENS,"**","E","PRVDAT")
I $D(PATIENS) D GETS^DIQ(52.46,PATIENS,"**","E","PATDAT")
; pharmacy information
I $D(PHARIENS) D
.S PHNM=$G(PHARDAT(52.47,PHARIENS,.05,"E"))
.S PHAD1=$G(PHARDAT(52.47,PHARIENS,1.1,"E"))
.S PHAD2=$G(PHARDAT(52.47,PHARIENS,1.2,"E"))
.S PHCTY=$G(PHARDAT(52.47,PHARIENS,1.3,"E"))
.S PHST=$G(PHARDAT(52.47,PHARIENS,1.4,"E"))
.S PHZIP=$G(PHARDAT(52.47,PHARIENS,1.5,"E"))
.I S2017 D
..S PHNCP=$G(PHARDAT(52.47,PHARIENS,10.1,"E"))
..S PHTEL=$$COMMVAL^PSOERXU5(PHARIEN,52.47,7,"PT",1) ; Add extension
.I 'S2017 D
..S PHNCP=$G(PHARDAT(52.47,PHARIENS,.02,"E"))
..S PHTEL=$$COMMVAL^PSOERXU5(PHARIEN,52.47,7,"PT",1)
; provider information
I $D(PRVIENS) D
.S PRFNM=$G(PRVDAT(52.48,PRVIENS,.03,"E"))
.S PRMNM=$G(PRVDAT(52.48,PRVIENS,.04,"E"))
.S PRLNM=$G(PRVDAT(52.48,PRVIENS,.02,"E"))
.S PRAD1=$G(PRVDAT(52.48,PRVIENS,4.1,"E"))
.S PRAD2=$G(PRVDAT(52.48,PRVIENS,4.2,"E"))
.S PRCTY=$G(PRVDAT(52.48,PRVIENS,4.3,"E"))
.S PRST=$G(PRVDAT(52.48,PRVIENS,4.4,"E"))
.S PRZIP=$G(PRVDAT(52.48,PRVIENS,4.5,"E"))
.I S2017 D
..S PRNPI=$G(PRVDAT(52.48,PRVIENS,15.1,"E"))
..S PRDEA=$G(PRVDAT(52.48,PRVIENS,14.5,"E"))
..S PRSTL=$G(PRVDAT(52.48,PRVIENS,14.1,"E"))
.I 'S2017 D
..S PRNPI=$G(PRVDAT(52.48,PRVIENS,1.5,"E"))
..S PRDEA=$G(PRVDAT(52.48,PRVIENS,1.6,"E"))
..S PRSTL=$G(PRVDAT(52.48,PRVIENS,1.8,"E"))
.I '$G(NEWRXIEN) S PRSUPER=$$GET1^DIQ(52.49,PSOIEN,2.6,"E")
.I $G(NEWRXIEN) S PRSUPER=$$GET1^DIQ(52.49,NEWRXIEN,2.6,"E")
.S PRAGNTFN=$$GET1^DIQ(52.48,PRVIEN,5.2,"E")
.S PRAGNTMN=$$GET1^DIQ(52.48,PRVIEN,5.3,"E")
.S PRAGNTLN=$$GET1^DIQ(52.48,PRVIEN,5.1,"E")
.I S2017 D
..S PRTEL=$$COMMVAL^PSOERXU5(PRVIEN,52.48,11,"PT",1) ; Add extension
..S PRFAX=$$COMMVAL^PSOERXU5(PRVIEN,52.48,11,"F",1) ; Add extension
.I 'S2017 D
..S SIEN=0
..F S SIEN=$O(^PS(52.48,PRVIEN,3,SIEN)) Q:'SIEN D
...S IENS=SIEN_","_PRVIEN_","
...S TYPE=$$GET1^DIQ(52.483,IENS,.02)
...S VALUE=$$GET1^DIQ(52.483,IENS,.01)
...D
....I TYPE="FAX" S PRFAX=VALUE Q
....I TYPE="TELEPHONE" S PRTEL=VALUE
I '$D(PRVIENS) D
.S (PRFNM,PRMNM,PRLNM,PRAD1,PRAD2,PRCTY,PRST,PRZIP)=""
.S (PRNPI,PRDEA,PRSTL)=""
.I '$G(NEWRXIEN) S PRSUPER=$$GET1^DIQ(52.49,PSOIEN,2.6,"E")
.I $G(NEWRXIEN) S PRSUPER=$$GET1^DIQ(52.49,NEWRXIEN,2.6,"E")
.S (PRAGNTFN,PRAGNTMN,PRAGNTLN)=""
.S (PRTEL,PRFAX)=""
; patient information
I $D(PATIENS) D
.S PTLNM=$G(PATDAT(52.46,PATIENS,.02,"E"))
.S PTMNM=$G(PATDAT(52.46,PATIENS,.04,"E"))
.S PTFNM=$G(PATDAT(52.46,PATIENS,.03,"E"))
.S PTAD1=$G(PATDAT(52.46,PATIENS,3.1,"E"))
.S PTAD2=$G(PATDAT(52.46,PATIENS,3.2,"E"))
.S PTCTY=$G(PATDAT(52.46,PATIENS,3.3,"E"))
.S PTST=$G(PATDAT(52.46,PATIENS,3.4,"E"))
.S PTZIP=$G(PATDAT(52.46,PATIENS,3.5,"E"))
.S PTDOB=$G(PATDAT(52.46,PATIENS,.08,"E"))
.S PTGEN=$G(PATDAT(52.46,PATIENS,.07,"E"))
.S PTSSN=$G(PATDAT(52.46,PATIENS,$S(S2017:18.2,1:1.4),"E"))
.S PTHPHON=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
W !,"*************************PHARMACY INFORMATION****************************"
I MTYPE="RR" D
.N NEWRXIEN
.S NEWRXIEN=$$RESOLV^PSOERXU2(PSOIEN)
.S:NEWRXIEN PHNCP=$$GET1^DIQ(52.49,NEWRXIEN,22.3)
I $D(PHARIENS) D
.W !,$$UP^XLFSTR(PHNM)
.W !,"Address: "_PHAD1
.W ! W:$L(PHAD2) " "_PHAD2
.W !!," "_PHCTY_", "_PHST_" "_PHZIP
.S LTXT=""
.D ADDITEM^PSOERX1A(.LTXT,"Primary Telephone: ",PHTEL,1,40)
.D ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",PHNCP,42,26)
.W !,LTXT S LTXT=""
I '$D(PHARIENS) D
.W !,"Recipient pharmacy name and address missing."
.S LTXT=""
.D ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",$G(PHNCP),1,26)
.W !!,LTXT S LTXT=""
W !,"******************PRESCRIBER INFORMATION*********************************"
W !,"Last: "_PRLNM
W !,"First: "_PRFNM
W !,"Mid: "_PRMNM
W !,"Address: "_PRAD1
I $L(PRAD2) W !," "_PRAD2
W !," "_PRCTY_", "_PRST_" "_PRZIP
S LTXT=""
W !,"NPI: "_PRNPI
W !,"DEA: "_PRDEA
W !,"State Lic: "_PRSTL
W !,LTXT S LTXT=""
W !,"Primary Telephone: "_$G(PRTEL)
W !,"Fax: "_$G(PRFAX)
W !,LTXT S LTXT=""
W !,"Supervisor: "_$G(PRSUPER)
W !,"Agent Last Name: "_$G(PRAGNTLN)
W !,"Agent First Name: "_$G(PRAGNTFN)
W !,"Agent Middle Name: "_$G(PRAGNTMN)
W !,"******************PATIENT INFORMATION************************************"
S LTXT=""
I $D(PATIENS) D
.W !,"Last: "_PTLNM
.W !,"First: "_PTFNM
.W !,"Mid: "_PTMNM
.W !,LTXT
.S LTXT=""
.D ADDITEM^PSOERX1A(.LTXT,"SSN: ",PTSSN,1,28)
.D ADDITEM^PSOERX1A(.LTXT,"Sex: ",PTGEN,30,20) W !,LTXT S LTXT=""
.W !,"Address: "_PTAD1
.I $L(PTAD2) W !," "_PTAD2
.W !," "_PTCTY_", "_PTST_" "_PTZIP
.S LTXT=""
.D ADDITEM^PSOERX1A(.LTXT,"DOB: ",PTDOB,1,26)
.D ADDITEM^PSOERX1A(.LTXT,"Primary Telephone: ",PTHPHON,28,29)
.W !,LTXT
.S LTXT=""
. S LTXT=""
I S2017 D
.S PHW=$$BHW^PSOERXIU(PSOIEN) W !,PHW
W !,"******************PRESCRIPTION INFORMATION*******************************"
Q:$$SHORTPI^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
W !,"eRx Drug: "_$$GET1^DIQ(52.49,PSOIEN,3.1,"E")_" "_$P($$ERXDRSCH^PSOERXUT(+PSOIENS),"^",2)
W !,$$DRUGCODE(PSOIEN,+$G(MEDIEN))
S LTXT=""
D ADDITEM^PSOERX1A(.LTXT,"Qty: ",$$GET1^DIQ(52.49,PSOIEN,5.1,"E"),1,26)
D ADDITEM^PSOERX1A(.LTXT,"Days Supply: ",$$GET1^DIQ(52.49,PSOIEN,5.5,"E"),28,16)
S ERXWDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
I 'S2017 W !,"Date Written: "_$$FMTE^XLFDT(ERXWDATE,"2D")
I S2017 D
.S ERXEFFDT=$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN)
.W !,"eRx Written Date: "_$$FMTE^XLFDT($P(ERXWDATE,"."),1)_" eRx Issue Date: "_ERXEFFDT
W !,LTXT S LTXT=""
I 'S2017 W !,"Code List Qualifier: "_$$GET1^DIQ(52.49,PSOIEN,5.2,"E")
I S2017 D
.N ERXQQ
.S ERXQQ=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",2.2,"I"),ERXQQ=$$GET1^DIQ(52.45,ERXQQ,.02,"E")
.W !,"Code List Qualifier: "_ERXQQ
W !,"Drug Form: "_$$GET1^DIQ(52.49,PSOIEN,41,"E")
W !,"Strength: "_$$GET1^DIQ(52.49,PSOIEN,43,"E")
W !,LTXT S LTXT=""
I S2017 D
.S REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
.;setting 10.6 refill value
I 'S2017 D
.S REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
.I REFILL="" D
..S REFILL=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
; refills for a refill response is # of refills-1
I MTYPE="RE",REFILL S REFILL=REFILL-1
W !,"Refills: "_REFILL
S EXSTATUS=$$GET1^DIQ(52.49,PSOIEN,1,"E")
I S2017 D
.I MTYPE="N"!((MTYPE="CX")&($$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI))) D
..S PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
..S PROHIBIT=$S(PROHIBIT=1:"Yes",1:"No")
..W !,"Prohibit Renewals: "_PROHIBIT
S ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
W !,"Substitutions?: "_ERXDSUB
I 'S2017 W !,"SIG: "_$$GET1^DIQ(52.49,PSOIEN,7,"E")
I S2017 D
.W !,"eRx Sig:"
.Q:$G(MEDIEN)=""
.S SGLOOP=0 F S SGLOOP=$O(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP)) Q:'SGLOOP D
..W !,$G(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0))
W !!,"eRx Reference #: ",$$GET1^DIQ(52.49,PSOIEN,.01,"E")
W !,"Message ID: ",$$GET1^DIQ(52.49,PSOIEN,25,"E")
W LTXT S LTXT=""
S ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
W !,"Substitutions?: "_ERXDSUB
W !,"Comments: "_$$GET1^DIQ(52.49,PSOIEN,8,"E")
;;BEGIN TEST
I MTYPE="CA"!(MTYPE="RR") D
.S LINE=1 K @VALMAR
.I MTYPE="CA" D CANREQ^PSOERXU5(CANREQ,.LINE,1),CANRES^PSOERXU5(CANREQ,.LINE,1),MSGHIS^PSOERXU3(CANREQ,.LINE)
.I MTYPE="RR" D
..I S2017 D MEDDIS^PSOERXU7(CANREQ,.LINE)
..I 'S2017 D MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
..D RRREQ^PSOERXU3(CANREQ,.LINE),RRRES^PSOERXU3(CANREQ,.LINE),MSGHIS^PSOERXU3(CANREQ,.LINE)
.S LOOP=0 F S LOOP=$O(@VALMAR@(LOOP)) Q:'LOOP D
..W !,$G(@VALMAR@(LOOP,0))
.K @VALMAR
I MTYPE="CN"!(MTYPE="RE") D
.S LINE=1 K @VALMAR
.I MTYPE="CN" D CANRES^PSOERXU5(CANRES,.LINE,1),CANREQ^PSOERXU5(CANRES,.LINE,1),MSGHIS^PSOERXU3(CANRES,.LINE)
.I MTYPE="RE" D
..S R2017=$$GET1^DIQ(52.49,CANREQ,312.1,"I")
..I 'S2017,'R2017 D MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
..I S2017,'R2017 D MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
..I S2017,R2017 D MEDDIS^PSOERXU7(CANREQ,.LINE)
..D RRRES^PSOERXU3(CANRES,.LINE),RRREQ^PSOERXU3(CANRES,.LINE),MSGHIS^PSOERXU3(CANRES,.LINE)
..S LOOP=0 F S LOOP=$O(@VALMAR@(LOOP)) Q:'LOOP D
...W !,$G(@VALMAR@(LOOP,0))
..K @VALMAR
I ",CX,CR,"[(","_MTYPE_",") D
.D CHGEND^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
W !,"*******************************END OF eRx********************************"
D:'$D(ZTQUEUED) ^%ZISC
Q
DISPCHK(CANREQ,LINE,S2017) ;
N REQ2017,MTYPE
S MTYPE=$$GET1^DIQ(52.49,CANREQ,.08,"I")
I MTYPE="RE" S REQ2017=$$GET1^DIQ(52.49,CANREQ,312.1,"I")
I $G(S2017),$G(REQ2017) D MEDDIS^PSOERXU7(CANREQ,.LINE) Q
D MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
Q
;
DRUGCODE(PSOIEN,MEDIEN) ; Returns the Drug Code (Print format: e.g.: "NDC: 1939994449")
N CODE,QUAL
S CODE=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",1.1,"I")
S QUAL=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",1.2,"E")
S:QUAL="ND" QUAL="NDC"
Q $S(CODE'="":QUAL_": "_CODE,1:"NDC:")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1C 11778 printed Apr 09, 2024@21:29:23 Page 2
PSOERX1C ;ALB/BWF - eRx Utilities ; 11/27/2019 10:20am
+1 ;;7.0;OUTPATIENT PHARMACY;**467,520,527,508,551,581,617,646,700**;DEC 1997;Build 261
+2 ;
+3 QUIT
+4 ; select an item
PRINT(PSOIEN,OP) ;
+1 NEW %ZIS,POP
+2 SET OP=$GET(OP)
+3 DO FULL^VALM1
+4 SET VALMBCK="R"
+5 SET %ZIS="Q"
SET %ZIS("B")=$GET(PSOPROP)
DO ^%ZIS
if POP
QUIT
+6 ; if queuing, queue it and quit.
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTSAVE("PSOIEN")=""
SET ZTSAVE("OP")=""
SET ZTSAVE("VALMAR")=""
SET ZTSAVE("VALMEVL")=""
+9 SET ZTRTN="PRINTQ^PSOERX1C(PSOIEN,OP)"
SET ZTDESC="eRx Print"
DO ^%ZTLOAD
+10 KILL ZTSAVE,ZTRTN
+11 DO INIT^PSOERX1
+12 DO TERM^VALM0
End DoDot:1
QUIT
+13 DO PRINTQ(PSOIEN,OP)
+14 DO TERM^VALM0
+15 DO INIT^PSOERX1
+16 QUIT
+17 ; fall through if no queueing
PRINTQ(PSOIEN,OP) ;
+1 NEW %ZIS,POP,RXDAT,PHARIEN,PRVIEN,PATIEN,PHARDAT,PRVDAT,PATDAT,PSOIENS,PHNM,PHAD1,PHAD2,PHCTY,LINE,LOOP,PROHIBIT,ERXWDATE
+2 NEW PHST,PHZIP,PHNCP,PHTEL,PRFNM,PRLNM,PRMNM,PRAD1,PRAD2,PRCTY,PRST,PRZIP,PRNPI,PRDEA,PRSTL,LTXT,MTYPE,NEWRXIEN,ERXEFFDT,PHW,SGLOOP
+3 NEW PRTEL,PRFAX,PRSUPER,PRAGNT,PTLNM,PTFNM,PTMNM,PTAD1,PTAD2,PTCTY,PTST,PTZIP,PTDOB,PTGEN,PTHPHON,S2017,MEDIEN,R2017
+4 NEW PHARIENS,PATIENS,PRVIENS,PTSSN,PRAGNTFN,PRAGNTMN,PRAGNTLN,TYPE,VALUE,SIEN,REFILL,IENS,CANREQ,CANRES,ERXDSUB,EXSTATUS
+5 NEW CHGMESRI,CHGMESRQ,RESPVAL,DRUGCODE
+6 SET OP=$GET(OP,"")
+7 SET PSOIEN=$GET(PSOIEN)
+8 IF '$GET(PSOIEN)
Begin DoDot:1
+9 IF $DATA(RXOR)
SET PSOIEN=$$CHKERX^PSOERXU1($PIECE(RXOR,U,2))
if PSOIEN
QUIT
+10 IF $DATA(OR0)
SET PSOIEN=$$CHKERX^PSOERXU1(OR0)
End DoDot:1
+11 if '$GET(PSOIEN)
QUIT
+12 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+13 SET CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
+14 SET CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
+15 SET RESPVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
+16 IF MTYPE="CN"!(MTYPE="RE")!(MTYPE="IE")
Begin DoDot:1
+17 SET CANRES=PSOIEN
+18 SET CANREQ=$$GETREQ^PSOERXU2(PSOIEN)
+19 IF $GET(CANREQ)
Begin DoDot:2
+20 SET NEWRXIEN=$$RESOLV^PSOERXU2(CANREQ)
+21 ; if there is no NewRx related to this request, pull the data from the cancel request itself.
+22 IF '$PIECE(NEWRXIEN,U)
SET NEWRXIEN=$GET(CANREQ)
End DoDot:2
End DoDot:1
+23 IF MTYPE="CA"!(MTYPE="RR")
Begin DoDot:1
+24 SET CANREQ=PSOIEN
SET CANRES=$$GETRESP^PSOERXU2(CANREQ)
+25 SET NEWRXIEN=$$RESOLV^PSOERXU2(CANREQ)
+26 IF '$PIECE(NEWRXIEN,U)
SET NEWRXIEN=$GET(CANREQ)
End DoDot:1
+27 ; if we found the newrxien because of a different message type, reset PSOIEN to pull rx info from the newrx.
+28 SET S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
+29 IF S2017
Begin DoDot:1
+30 IF MTYPE'="RE"
Begin DoDot:2
+31 SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","P",0))
End DoDot:2
+32 IF MTYPE="RE"
Begin DoDot:2
+33 SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","MR",0))
End DoDot:2
End DoDot:1
+34 SET PSOIENS=PSOIEN_","
+35 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+36 USE IO
+37 DO GETS^DIQ(52.49,PSOIENS,".04;.08;2.1;2.5","I","RXDAT")
+38 SET PHARIEN=$GET(RXDAT(52.49,PSOIENS,2.5,"I"))
+39 if PHARIEN
SET PHARIENS=PHARIEN_","
+40 SET PRVIEN=$GET(RXDAT(52.49,PSOIENS,2.1,"I"))
+41 if PRVIEN
SET PRVIENS=PRVIEN_","
+42 SET PATIEN=$GET(RXDAT(52.49,PSOIENS,.04,"I"))
+43 if PATIEN
SET PATIENS=PATIEN_","
+44 IF $DATA(PHARIENS)
DO GETS^DIQ(52.47,PHARIENS,"**","E","PHARDAT")
+45 IF $DATA(PRVIENS)
DO GETS^DIQ(52.48,PRVIENS,"**","E","PRVDAT")
+46 IF $DATA(PATIENS)
DO GETS^DIQ(52.46,PATIENS,"**","E","PATDAT")
+47 ; pharmacy information
+48 IF $DATA(PHARIENS)
Begin DoDot:1
+49 SET PHNM=$GET(PHARDAT(52.47,PHARIENS,.05,"E"))
+50 SET PHAD1=$GET(PHARDAT(52.47,PHARIENS,1.1,"E"))
+51 SET PHAD2=$GET(PHARDAT(52.47,PHARIENS,1.2,"E"))
+52 SET PHCTY=$GET(PHARDAT(52.47,PHARIENS,1.3,"E"))
+53 SET PHST=$GET(PHARDAT(52.47,PHARIENS,1.4,"E"))
+54 SET PHZIP=$GET(PHARDAT(52.47,PHARIENS,1.5,"E"))
+55 IF S2017
Begin DoDot:2
+56 SET PHNCP=$GET(PHARDAT(52.47,PHARIENS,10.1,"E"))
+57 ; Add extension
SET PHTEL=$$COMMVAL^PSOERXU5(PHARIEN,52.47,7,"PT",1)
End DoDot:2
+58 IF 'S2017
Begin DoDot:2
+59 SET PHNCP=$GET(PHARDAT(52.47,PHARIENS,.02,"E"))
+60 SET PHTEL=$$COMMVAL^PSOERXU5(PHARIEN,52.47,7,"PT",1)
End DoDot:2
End DoDot:1
+61 ; provider information
+62 IF $DATA(PRVIENS)
Begin DoDot:1
+63 SET PRFNM=$GET(PRVDAT(52.48,PRVIENS,.03,"E"))
+64 SET PRMNM=$GET(PRVDAT(52.48,PRVIENS,.04,"E"))
+65 SET PRLNM=$GET(PRVDAT(52.48,PRVIENS,.02,"E"))
+66 SET PRAD1=$GET(PRVDAT(52.48,PRVIENS,4.1,"E"))
+67 SET PRAD2=$GET(PRVDAT(52.48,PRVIENS,4.2,"E"))
+68 SET PRCTY=$GET(PRVDAT(52.48,PRVIENS,4.3,"E"))
+69 SET PRST=$GET(PRVDAT(52.48,PRVIENS,4.4,"E"))
+70 SET PRZIP=$GET(PRVDAT(52.48,PRVIENS,4.5,"E"))
+71 IF S2017
Begin DoDot:2
+72 SET PRNPI=$GET(PRVDAT(52.48,PRVIENS,15.1,"E"))
+73 SET PRDEA=$GET(PRVDAT(52.48,PRVIENS,14.5,"E"))
+74 SET PRSTL=$GET(PRVDAT(52.48,PRVIENS,14.1,"E"))
End DoDot:2
+75 IF 'S2017
Begin DoDot:2
+76 SET PRNPI=$GET(PRVDAT(52.48,PRVIENS,1.5,"E"))
+77 SET PRDEA=$GET(PRVDAT(52.48,PRVIENS,1.6,"E"))
+78 SET PRSTL=$GET(PRVDAT(52.48,PRVIENS,1.8,"E"))
End DoDot:2
+79 IF '$GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,PSOIEN,2.6,"E")
+80 IF $GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,NEWRXIEN,2.6,"E")
+81 SET PRAGNTFN=$$GET1^DIQ(52.48,PRVIEN,5.2,"E")
+82 SET PRAGNTMN=$$GET1^DIQ(52.48,PRVIEN,5.3,"E")
+83 SET PRAGNTLN=$$GET1^DIQ(52.48,PRVIEN,5.1,"E")
+84 IF S2017
Begin DoDot:2
+85 ; Add extension
SET PRTEL=$$COMMVAL^PSOERXU5(PRVIEN,52.48,11,"PT",1)
+86 ; Add extension
SET PRFAX=$$COMMVAL^PSOERXU5(PRVIEN,52.48,11,"F",1)
End DoDot:2
+87 IF 'S2017
Begin DoDot:2
+88 SET SIEN=0
+89 FOR
SET SIEN=$ORDER(^PS(52.48,PRVIEN,3,SIEN))
if 'SIEN
QUIT
Begin DoDot:3
+90 SET IENS=SIEN_","_PRVIEN_","
+91 SET TYPE=$$GET1^DIQ(52.483,IENS,.02)
+92 SET VALUE=$$GET1^DIQ(52.483,IENS,.01)
+93 Begin DoDot:4
+94 IF TYPE="FAX"
SET PRFAX=VALUE
QUIT
+95 IF TYPE="TELEPHONE"
SET PRTEL=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+96 IF '$DATA(PRVIENS)
Begin DoDot:1
+97 SET (PRFNM,PRMNM,PRLNM,PRAD1,PRAD2,PRCTY,PRST,PRZIP)=""
+98 SET (PRNPI,PRDEA,PRSTL)=""
+99 IF '$GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,PSOIEN,2.6,"E")
+100 IF $GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,NEWRXIEN,2.6,"E")
+101 SET (PRAGNTFN,PRAGNTMN,PRAGNTLN)=""
+102 SET (PRTEL,PRFAX)=""
End DoDot:1
+103 ; patient information
+104 IF $DATA(PATIENS)
Begin DoDot:1
+105 SET PTLNM=$GET(PATDAT(52.46,PATIENS,.02,"E"))
+106 SET PTMNM=$GET(PATDAT(52.46,PATIENS,.04,"E"))
+107 SET PTFNM=$GET(PATDAT(52.46,PATIENS,.03,"E"))
+108 SET PTAD1=$GET(PATDAT(52.46,PATIENS,3.1,"E"))
+109 SET PTAD2=$GET(PATDAT(52.46,PATIENS,3.2,"E"))
+110 SET PTCTY=$GET(PATDAT(52.46,PATIENS,3.3,"E"))
+111 SET PTST=$GET(PATDAT(52.46,PATIENS,3.4,"E"))
+112 SET PTZIP=$GET(PATDAT(52.46,PATIENS,3.5,"E"))
+113 SET PTDOB=$GET(PATDAT(52.46,PATIENS,.08,"E"))
+114 SET PTGEN=$GET(PATDAT(52.46,PATIENS,.07,"E"))
+115 SET PTSSN=$GET(PATDAT(52.46,PATIENS,$SELECT(S2017:18.2,1:1.4),"E"))
+116 SET PTHPHON=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
End DoDot:1
+117 WRITE !,"*************************PHARMACY INFORMATION****************************"
+118 IF MTYPE="RR"
Begin DoDot:1
+119 NEW NEWRXIEN
+120 SET NEWRXIEN=$$RESOLV^PSOERXU2(PSOIEN)
+121 if NEWRXIEN
SET PHNCP=$$GET1^DIQ(52.49,NEWRXIEN,22.3)
End DoDot:1
+122 IF $DATA(PHARIENS)
Begin DoDot:1
+123 WRITE !,$$UP^XLFSTR(PHNM)
+124 WRITE !,"Address: "_PHAD1
+125 WRITE !
if $LENGTH(PHAD2)
WRITE " "_PHAD2
+126 WRITE !!," "_PHCTY_", "_PHST_" "_PHZIP
+127 SET LTXT=""
+128 DO ADDITEM^PSOERX1A(.LTXT,"Primary Telephone: ",PHTEL,1,40)
+129 DO ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",PHNCP,42,26)
+130 WRITE !,LTXT
SET LTXT=""
End DoDot:1
+131 IF '$DATA(PHARIENS)
Begin DoDot:1
+132 WRITE !,"Recipient pharmacy name and address missing."
+133 SET LTXT=""
+134 DO ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",$GET(PHNCP),1,26)
+135 WRITE !!,LTXT
SET LTXT=""
End DoDot:1
+136 WRITE !,"******************PRESCRIBER INFORMATION*********************************"
+137 WRITE !,"Last: "_PRLNM
+138 WRITE !,"First: "_PRFNM
+139 WRITE !,"Mid: "_PRMNM
+140 WRITE !,"Address: "_PRAD1
+141 IF $LENGTH(PRAD2)
WRITE !," "_PRAD2
+142 WRITE !," "_PRCTY_", "_PRST_" "_PRZIP
+143 SET LTXT=""
+144 WRITE !,"NPI: "_PRNPI
+145 WRITE !,"DEA: "_PRDEA
+146 WRITE !,"State Lic: "_PRSTL
+147 WRITE !,LTXT
SET LTXT=""
+148 WRITE !,"Primary Telephone: "_$GET(PRTEL)
+149 WRITE !,"Fax: "_$GET(PRFAX)
+150 WRITE !,LTXT
SET LTXT=""
+151 WRITE !,"Supervisor: "_$GET(PRSUPER)
+152 WRITE !,"Agent Last Name: "_$GET(PRAGNTLN)
+153 WRITE !,"Agent First Name: "_$GET(PRAGNTFN)
+154 WRITE !,"Agent Middle Name: "_$GET(PRAGNTMN)
+155 WRITE !,"******************PATIENT INFORMATION************************************"
+156 SET LTXT=""
+157 IF $DATA(PATIENS)
Begin DoDot:1
+158 WRITE !,"Last: "_PTLNM
+159 WRITE !,"First: "_PTFNM
+160 WRITE !,"Mid: "_PTMNM
+161 WRITE !,LTXT
+162 SET LTXT=""
+163 DO ADDITEM^PSOERX1A(.LTXT,"SSN: ",PTSSN,1,28)
+164 DO ADDITEM^PSOERX1A(.LTXT,"Sex: ",PTGEN,30,20)
WRITE !,LTXT
SET LTXT=""
+165 WRITE !,"Address: "_PTAD1
+166 IF $LENGTH(PTAD2)
WRITE !," "_PTAD2
+167 WRITE !," "_PTCTY_", "_PTST_" "_PTZIP
+168 SET LTXT=""
+169 DO ADDITEM^PSOERX1A(.LTXT,"DOB: ",PTDOB,1,26)
+170 DO ADDITEM^PSOERX1A(.LTXT,"Primary Telephone: ",PTHPHON,28,29)
+171 WRITE !,LTXT
+172 SET LTXT=""
+173 SET LTXT=""
End DoDot:1
+174 IF S2017
Begin DoDot:1
+175 SET PHW=$$BHW^PSOERXIU(PSOIEN)
WRITE !,PHW
End DoDot:1
+176 WRITE !,"******************PRESCRIPTION INFORMATION*******************************"
+177 if $$SHORTPI^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
QUIT
+178 WRITE !,"eRx Drug: "_$$GET1^DIQ(52.49,PSOIEN,3.1,"E")_" "_$PIECE($$ERXDRSCH^PSOERXUT(+PSOIENS),"^",2)
+179 WRITE !,$$DRUGCODE(PSOIEN,+$GET(MEDIEN))
+180 SET LTXT=""
+181 DO ADDITEM^PSOERX1A(.LTXT,"Qty: ",$$GET1^DIQ(52.49,PSOIEN,5.1,"E"),1,26)
+182 DO ADDITEM^PSOERX1A(.LTXT,"Days Supply: ",$$GET1^DIQ(52.49,PSOIEN,5.5,"E"),28,16)
+183 SET ERXWDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
+184 IF 'S2017
WRITE !,"Date Written: "_$$FMTE^XLFDT(ERXWDATE,"2D")
+185 IF S2017
Begin DoDot:1
+186 SET ERXEFFDT=$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN)
+187 WRITE !,"eRx Written Date: "_$$FMTE^XLFDT($PIECE(ERXWDATE,"."),1)_" eRx Issue Date: "_ERXEFFDT
End DoDot:1
+188 WRITE !,LTXT
SET LTXT=""
+189 IF 'S2017
WRITE !,"Code List Qualifier: "_$$GET1^DIQ(52.49,PSOIEN,5.2,"E")
+190 IF S2017
Begin DoDot:1
+191 NEW ERXQQ
+192 SET ERXQQ=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",2.2,"I")
SET ERXQQ=$$GET1^DIQ(52.45,ERXQQ,.02,"E")
+193 WRITE !,"Code List Qualifier: "_ERXQQ
End DoDot:1
+194 WRITE !,"Drug Form: "_$$GET1^DIQ(52.49,PSOIEN,41,"E")
+195 WRITE !,"Strength: "_$$GET1^DIQ(52.49,PSOIEN,43,"E")
+196 WRITE !,LTXT
SET LTXT=""
+197 IF S2017
Begin DoDot:1
+198 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+199 ;setting 10.6 refill value
End DoDot:1
+200 IF 'S2017
Begin DoDot:1
+201 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+202 IF REFILL=""
Begin DoDot:2
+203 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
End DoDot:2
End DoDot:1
+204 ; refills for a refill response is # of refills-1
+205 IF MTYPE="RE"
IF REFILL
SET REFILL=REFILL-1
+206 WRITE !,"Refills: "_REFILL
+207 SET EXSTATUS=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+208 IF S2017
Begin DoDot:1
+209 IF MTYPE="N"!((MTYPE="CX")&($$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI)))
Begin DoDot:2
+210 SET PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
+211 SET PROHIBIT=$SELECT(PROHIBIT=1:"Yes",1:"No")
+212 WRITE !,"Prohibit Renewals: "_PROHIBIT
End DoDot:2
End DoDot:1
+213 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+214 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+215 WRITE !,"Substitutions?: "_ERXDSUB
+216 IF 'S2017
WRITE !,"SIG: "_$$GET1^DIQ(52.49,PSOIEN,7,"E")
+217 IF S2017
Begin DoDot:1
+218 WRITE !,"eRx Sig:"
+219 if $GET(MEDIEN)=""
QUIT
+220 SET SGLOOP=0
FOR
SET SGLOOP=$ORDER(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP))
if 'SGLOOP
QUIT
Begin DoDot:2
+221 WRITE !,$GET(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0))
End DoDot:2
End DoDot:1
+222 WRITE !!,"eRx Reference #: ",$$GET1^DIQ(52.49,PSOIEN,.01,"E")
+223 WRITE !,"Message ID: ",$$GET1^DIQ(52.49,PSOIEN,25,"E")
+224 WRITE LTXT
SET LTXT=""
+225 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+226 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+227 WRITE !,"Substitutions?: "_ERXDSUB
+228 WRITE !,"Comments: "_$$GET1^DIQ(52.49,PSOIEN,8,"E")
+229 ;;BEGIN TEST
+230 IF MTYPE="CA"!(MTYPE="RR")
Begin DoDot:1
+231 SET LINE=1
KILL @VALMAR
+232 IF MTYPE="CA"
DO CANREQ^PSOERXU5(CANREQ,.LINE,1)
DO CANRES^PSOERXU5(CANREQ,.LINE,1)
DO MSGHIS^PSOERXU3(CANREQ,.LINE)
+233 IF MTYPE="RR"
Begin DoDot:2
+234 IF S2017
DO MEDDIS^PSOERXU7(CANREQ,.LINE)
+235 IF 'S2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+236 DO RRREQ^PSOERXU3(CANREQ,.LINE)
DO RRRES^PSOERXU3(CANREQ,.LINE)
DO MSGHIS^PSOERXU3(CANREQ,.LINE)
End DoDot:2
+237 SET LOOP=0
FOR
SET LOOP=$ORDER(@VALMAR@(LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+238 WRITE !,$GET(@VALMAR@(LOOP,0))
End DoDot:2
+239 KILL @VALMAR
End DoDot:1
+240 IF MTYPE="CN"!(MTYPE="RE")
Begin DoDot:1
+241 SET LINE=1
KILL @VALMAR
+242 IF MTYPE="CN"
DO CANRES^PSOERXU5(CANRES,.LINE,1)
DO CANREQ^PSOERXU5(CANRES,.LINE,1)
DO MSGHIS^PSOERXU3(CANRES,.LINE)
+243 IF MTYPE="RE"
Begin DoDot:2
+244 SET R2017=$$GET1^DIQ(52.49,CANREQ,312.1,"I")
+245 IF 'S2017
IF 'R2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+246 IF S2017
IF 'R2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+247 IF S2017
IF R2017
DO MEDDIS^PSOERXU7(CANREQ,.LINE)
+248 DO RRRES^PSOERXU3(CANRES,.LINE)
DO RRREQ^PSOERXU3(CANRES,.LINE)
DO MSGHIS^PSOERXU3(CANRES,.LINE)
+249 SET LOOP=0
FOR
SET LOOP=$ORDER(@VALMAR@(LOOP))
if 'LOOP
QUIT
Begin DoDot:3
+250 WRITE !,$GET(@VALMAR@(LOOP,0))
End DoDot:3
+251 KILL @VALMAR
End DoDot:2
End DoDot:1
+252 IF ",CX,CR,"[(","_MTYPE_",")
Begin DoDot:1
+253 DO CHGEND^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
End DoDot:1
+254 WRITE !,"*******************************END OF eRx********************************"
+255 if '$DATA(ZTQUEUED)
DO ^%ZISC
+256 QUIT
DISPCHK(CANREQ,LINE,S2017) ;
+1 NEW REQ2017,MTYPE
+2 SET MTYPE=$$GET1^DIQ(52.49,CANREQ,.08,"I")
+3 IF MTYPE="RE"
SET REQ2017=$$GET1^DIQ(52.49,CANREQ,312.1,"I")
+4 IF $GET(S2017)
IF $GET(REQ2017)
DO MEDDIS^PSOERXU7(CANREQ,.LINE)
QUIT
+5 DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+6 QUIT
+7 ;
DRUGCODE(PSOIEN,MEDIEN) ; Returns the Drug Code (Print format: e.g.: "NDC: 1939994449")
+1 NEW CODE,QUAL
+2 SET CODE=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",1.1,"I")
+3 SET QUAL=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",1.2,"E")
+4 if QUAL="ND"
SET QUAL="NDC"
+5 QUIT $SELECT(CODE'="":QUAL_": "_CODE,1:"NDC:")
+6 QUIT
