PSOERX1C ;ALB/BWF - eRx Utilities ; 11/27/2019 10:20am
;;7.0;OUTPATIENT PHARMACY;**467,520,527,508,551,581,617,646,700,746,769**;DEC 1997;Build 26
;
Q
; select an item
PRINT(PSOIEN,OP) ;
N %ZIS,POP,DIR
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 TERM^VALM0
.D REF^PSOERSE1
D PRINTQ(PSOIEN,OP)
K DIR S DIR(0)="E" D ^DIR K DIR
D TERM^VALM0
D REF^PSOERSE1
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,PRVNOTES,DUEINFO,DDOT,DUECNT,REASON,RESULT,ICDINFO,ICD,ICDZ,CLINIC
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)=""
S CLINIC=$$GET1^DIQ(52.48,PRVIEN,18.6)
; 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 !,$$TITLELN("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:$L(PHAD2) !," "_PHAD2
.W !," "_PHCTY_", "_PHST_" "_PHZIP
.S LTXT=""
.D ADDITEM^PSOERX1A(.LTXT,"Primary Phone: ",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 !,$$TITLELN("PRESCRIBER INFORMATION")
W !,"Name: "_PRLNM_", "_PRFNM_" "_PRMNM
I $G(CLINIC)'="" W !,"Clinic: ",CLINIC
W !,"Address: "_PRAD1
I $L(PRAD2) W !," "_PRAD2
W !," "_PRCTY_", "_PRST_" "_PRZIP
W !,"NPI: "_PRNPI,?20,"DEA: "_PRDEA,?40,"State Lic: "_PRSTL
W !,"Primary Phone: "_$G(PRTEL),?40,"Fax: "_$G(PRFAX)
I $G(PRSUPER)'=""!($G(PRAGNTLN)'="") W !,"Supervisor: "_$G(PRSUPER) W:$G(PRAGNTLN)'="" ?45,"Agent: "_$G(PRAGNTLN)_", "_$G(PRAGNTFN)_" "_$G(PRAGNTMN)
W !,$$TITLELN("PATIENT INFORMATION")
S LTXT=""
I $D(PATIENS) D
.W !,"Name: "_PTLNM_", "_PTFNM_" "_PTMNM
.W !,"DOB: ",PTDOB,?19,"Sex: ",PTGEN,?33,"Primary Phone: ",PTHPHON,?64,"SSN: ",PTSSN
.W !,"Address: "_PTAD1
.I $L(PTAD2) W !," "_PTAD2
.W !," "_PTCTY_", "_PTST_" "_PTZIP
.S LTXT=""
I S2017 D
.S PHW=$$BHW^PSOERXIU(PSOIEN) W !,PHW
W !,$$TITLELN("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 ERXWDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
I 'S2017 W ?20,"Written Date: "_$$FMTE^XLFDT(ERXWDATE,"2D")
I S2017 D
.S ERXEFFDT=$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN)
.W ?20,"Written Date: "_$$FMTE^XLFDT($P(ERXWDATE,"."),1)_" Issue Date: "_ERXEFFDT
W !,"Qty: ",$$GET1^DIQ(52.49,PSOIEN,5.1,"E"),?20,"Days Supply: ",$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
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 ?45,"Refills: "_REFILL
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")
S EXSTATUS=$$GET1^DIQ(52.49,PSOIEN,1,"E")
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 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 ?30,"Prohibit Renewals: "_PROHIBIT
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))
S PRVNOTES=$$GET1^DIQ(52.49,PSOIEN,8)
I PRVNOTES'="" W !,"Provider Comments: ",PRVNOTES
;
;Prescriber Drug Use Evaluation
D PDUEDATA^PSOERXU9(.DUEINFO,PSOIEN,1)
I $D(DUEINFO) D
. S $P(DDOT,".",81)=""
. W !,$$TITLELN("PRESCRIBER DRUG USE EVALUATION")
. S DUECNT=0 F S DUECNT=$O(DUEINFO(DUECNT)) Q:'DUECNT D
. . W !,"Co-Agent: "_$P(DUEINFO(DUECNT),"^",8)
. . S REASON=$P(DUEINFO(DUECNT),"^",2) I $$PRESOLV^PSOERXA1(REASON,"REA") S REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
. . W !,"Reason: "_REASON
. . S RESULT=$P(DUEINFO(DUECNT),"^",4) I $$PRESOLV^PSOERXA1(RESULT,"RES") S RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
. . W !,"Result: "_RESULT
. . W !,"Override: "_$P(DUEINFO(DUECNT),"^",9)
. . I $O(DUEINFO(DUECNT)) W !,DDOT
;
;Diagnosis Code
D GETDIAGS^PSOERUT3(PSOIEN,.ICDINFO)
I $D(ICDINFO) D
. S $P(DDOT,".",81)=""
. W !,$$TITLELN("DIAGNOSIS INFORMATION")
. S ICD=0 F S ICD=$O(ICDINFO(ICD)) Q:'ICD D
. . S ICDZ=ICDINFO(ICD)
. . W !,$S($P(ICDZ,"^")="P":"Primary",1:"Secondary")_" Dx:"
. . W !,$P(ICDZ,"^",2)_" "_$P(ICDZ,"^",3)
. . W !,$P(ICDZ,"^",4)
. . I $O(ICDINFO(ICD)) W !,DDOT
;
K ^TMP("PSOERX1C",$J) M ^TMP("PSOERX1C",$J)=@VALMAR
W !!,"eRx Reference #: ",$$GET1^DIQ(52.49,PSOIEN,.01,"E")," 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:"")
;;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 !,$$TITLELN("END OF eRx")
K @VALMAR M @VALMAR=^TMP("PSOERX1C",$J) K ^TMP("PSOERX1C",$J)
D:'$D(ZTQUEUED) ^%ZISC
Q
;
TITLELN(TITLE) ; Title Line (Formats with _ around it, centered)
N TITLELN
S $P(TITLELN,"*",81)=""
S $E(TITLELN,(82-$L(TITLE))\2,(82-$L(TITLE))\2+$L(TITLE)-1)=TITLE
Q TITLELN
;
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 12733 printed Nov 22, 2024@17:38:12 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,746,769**;DEC 1997;Build 26
+2 ;
+3 QUIT
+4 ; select an item
PRINT(PSOIEN,OP) ;
+1 NEW %ZIS,POP,DIR
+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 TERM^VALM0
+12 DO REF^PSOERSE1
End DoDot:1
QUIT
+13 DO PRINTQ(PSOIEN,OP)
+14 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+15 DO TERM^VALM0
+16 DO REF^PSOERSE1
+17 QUIT
+18 ; 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,PRVNOTES,DUEINFO,DDOT,DUECNT,REASON,RESULT,ICDINFO,ICD,ICDZ,CLINIC
+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 SET CLINIC=$$GET1^DIQ(52.48,PRVIEN,18.6)
+104 ; patient information
+105 IF $DATA(PATIENS)
Begin DoDot:1
+106 SET PTLNM=$GET(PATDAT(52.46,PATIENS,.02,"E"))
+107 SET PTMNM=$GET(PATDAT(52.46,PATIENS,.04,"E"))
+108 SET PTFNM=$GET(PATDAT(52.46,PATIENS,.03,"E"))
+109 SET PTAD1=$GET(PATDAT(52.46,PATIENS,3.1,"E"))
+110 SET PTAD2=$GET(PATDAT(52.46,PATIENS,3.2,"E"))
+111 SET PTCTY=$GET(PATDAT(52.46,PATIENS,3.3,"E"))
+112 SET PTST=$GET(PATDAT(52.46,PATIENS,3.4,"E"))
+113 SET PTZIP=$GET(PATDAT(52.46,PATIENS,3.5,"E"))
+114 SET PTDOB=$GET(PATDAT(52.46,PATIENS,.08,"E"))
+115 SET PTGEN=$GET(PATDAT(52.46,PATIENS,.07,"E"))
+116 SET PTSSN=$GET(PATDAT(52.46,PATIENS,$SELECT(S2017:18.2,1:1.4),"E"))
+117 SET PTHPHON=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
End DoDot:1
+118 ;
+119 WRITE !,$$TITLELN("PHARMACY INFORMATION")
+120 IF MTYPE="RR"
Begin DoDot:1
+121 NEW NEWRXIEN
+122 SET NEWRXIEN=$$RESOLV^PSOERXU2(PSOIEN)
+123 if NEWRXIEN
SET PHNCP=$$GET1^DIQ(52.49,NEWRXIEN,22.3)
End DoDot:1
+124 IF $DATA(PHARIENS)
Begin DoDot:1
+125 WRITE !,$$UP^XLFSTR(PHNM)
+126 WRITE !,"Address: "_PHAD1
+127 if $LENGTH(PHAD2)
WRITE !," "_PHAD2
+128 WRITE !," "_PHCTY_", "_PHST_" "_PHZIP
+129 SET LTXT=""
+130 DO ADDITEM^PSOERX1A(.LTXT,"Primary Phone: ",PHTEL,1,40)
+131 DO ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",PHNCP,42,26)
+132 WRITE !,LTXT
SET LTXT=""
End DoDot:1
+133 IF '$DATA(PHARIENS)
Begin DoDot:1
+134 WRITE !,"Recipient pharmacy name and address missing."
+135 SET LTXT=""
+136 DO ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",$GET(PHNCP),1,26)
+137 WRITE !!,LTXT
SET LTXT=""
End DoDot:1
+138 WRITE !,$$TITLELN("PRESCRIBER INFORMATION")
+139 WRITE !,"Name: "_PRLNM_", "_PRFNM_" "_PRMNM
+140 IF $GET(CLINIC)'=""
WRITE !,"Clinic: ",CLINIC
+141 WRITE !,"Address: "_PRAD1
+142 IF $LENGTH(PRAD2)
WRITE !," "_PRAD2
+143 WRITE !," "_PRCTY_", "_PRST_" "_PRZIP
+144 WRITE !,"NPI: "_PRNPI,?20,"DEA: "_PRDEA,?40,"State Lic: "_PRSTL
+145 WRITE !,"Primary Phone: "_$GET(PRTEL),?40,"Fax: "_$GET(PRFAX)
+146 IF $GET(PRSUPER)'=""!($GET(PRAGNTLN)'="")
WRITE !,"Supervisor: "_$GET(PRSUPER)
if $GET(PRAGNTLN)'=""
WRITE ?45,"Agent: "_$GET(PRAGNTLN)_", "_$GET(PRAGNTFN)_" "_$GET(PRAGNTMN)
+147 WRITE !,$$TITLELN("PATIENT INFORMATION")
+148 SET LTXT=""
+149 IF $DATA(PATIENS)
Begin DoDot:1
+150 WRITE !,"Name: "_PTLNM_", "_PTFNM_" "_PTMNM
+151 WRITE !,"DOB: ",PTDOB,?19,"Sex: ",PTGEN,?33,"Primary Phone: ",PTHPHON,?64,"SSN: ",PTSSN
+152 WRITE !,"Address: "_PTAD1
+153 IF $LENGTH(PTAD2)
WRITE !," "_PTAD2
+154 WRITE !," "_PTCTY_", "_PTST_" "_PTZIP
+155 SET LTXT=""
End DoDot:1
+156 IF S2017
Begin DoDot:1
+157 SET PHW=$$BHW^PSOERXIU(PSOIEN)
WRITE !,PHW
End DoDot:1
+158 WRITE !,$$TITLELN("PRESCRIPTION INFORMATION")
+159 if $$SHORTPI^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
QUIT
+160 WRITE !,"eRx Drug: "_$$GET1^DIQ(52.49,PSOIEN,3.1,"E")_" "_$PIECE($$ERXDRSCH^PSOERXUT(+PSOIENS),"^",2)
+161 WRITE !,$$DRUGCODE(PSOIEN,+$GET(MEDIEN))
+162 SET ERXWDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
+163 IF 'S2017
WRITE ?20,"Written Date: "_$$FMTE^XLFDT(ERXWDATE,"2D")
+164 IF S2017
Begin DoDot:1
+165 SET ERXEFFDT=$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN)
+166 WRITE ?20,"Written Date: "_$$FMTE^XLFDT($PIECE(ERXWDATE,"."),1)_" Issue Date: "_ERXEFFDT
End DoDot:1
+167 WRITE !,"Qty: ",$$GET1^DIQ(52.49,PSOIEN,5.1,"E"),?20,"Days Supply: ",$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
+168 IF S2017
Begin DoDot:1
+169 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+170 ;setting 10.6 refill value
End DoDot:1
+171 IF 'S2017
Begin DoDot:1
+172 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+173 IF REFILL=""
Begin DoDot:2
+174 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
End DoDot:2
End DoDot:1
+175 ; refills for a refill response is # of refills-1
+176 IF MTYPE="RE"
IF REFILL
SET REFILL=REFILL-1
+177 WRITE ?45,"Refills: "_REFILL
+178 IF 'S2017
WRITE !,"Code List Qualifier: "_$$GET1^DIQ(52.49,PSOIEN,5.2,"E")
+179 IF S2017
Begin DoDot:1
+180 NEW ERXQQ
+181 SET ERXQQ=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",2.2,"I")
SET ERXQQ=$$GET1^DIQ(52.45,ERXQQ,.02,"E")
+182 WRITE !,"Code List Qualifier: "_ERXQQ
End DoDot:1
+183 WRITE !,"Drug Form: "_$$GET1^DIQ(52.49,PSOIEN,41,"E")
+184 WRITE !,"Strength: "_$$GET1^DIQ(52.49,PSOIEN,43,"E")
+185 SET EXSTATUS=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+186 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+187 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+188 WRITE !,"Substitutions?: "_ERXDSUB
+189 IF S2017
Begin DoDot:1
+190 IF MTYPE="N"!((MTYPE="CX")&($$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI)))
Begin DoDot:2
+191 SET PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
+192 SET PROHIBIT=$SELECT(PROHIBIT=1:"Yes",1:"No")
+193 WRITE ?30,"Prohibit Renewals: "_PROHIBIT
End DoDot:2
End DoDot:1
+194 IF 'S2017
WRITE !,"SIG: "_$$GET1^DIQ(52.49,PSOIEN,7,"E")
+195 IF S2017
Begin DoDot:1
+196 WRITE !,"eRx Sig:"
+197 if $GET(MEDIEN)=""
QUIT
+198 SET SGLOOP=0
FOR
SET SGLOOP=$ORDER(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP))
if 'SGLOOP
QUIT
Begin DoDot:2
+199 WRITE !,$GET(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0))
End DoDot:2
End DoDot:1
+200 SET PRVNOTES=$$GET1^DIQ(52.49,PSOIEN,8)
+201 IF PRVNOTES'=""
WRITE !,"Provider Comments: ",PRVNOTES
+202 ;
+203 ;Prescriber Drug Use Evaluation
+204 DO PDUEDATA^PSOERXU9(.DUEINFO,PSOIEN,1)
+205 IF $DATA(DUEINFO)
Begin DoDot:1
+206 SET $PIECE(DDOT,".",81)=""
+207 WRITE !,$$TITLELN("PRESCRIBER DRUG USE EVALUATION")
+208 SET DUECNT=0
FOR
SET DUECNT=$ORDER(DUEINFO(DUECNT))
if 'DUECNT
QUIT
Begin DoDot:2
+209 WRITE !,"Co-Agent: "_$PIECE(DUEINFO(DUECNT),"^",8)
+210 SET REASON=$PIECE(DUEINFO(DUECNT),"^",2)
IF $$PRESOLV^PSOERXA1(REASON,"REA")
SET REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
+211 WRITE !,"Reason: "_REASON
+212 SET RESULT=$PIECE(DUEINFO(DUECNT),"^",4)
IF $$PRESOLV^PSOERXA1(RESULT,"RES")
SET RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
+213 WRITE !,"Result: "_RESULT
+214 WRITE !,"Override: "_$PIECE(DUEINFO(DUECNT),"^",9)
+215 IF $ORDER(DUEINFO(DUECNT))
WRITE !,DDOT
End DoDot:2
End DoDot:1
+216 ;
+217 ;Diagnosis Code
+218 DO GETDIAGS^PSOERUT3(PSOIEN,.ICDINFO)
+219 IF $DATA(ICDINFO)
Begin DoDot:1
+220 SET $PIECE(DDOT,".",81)=""
+221 WRITE !,$$TITLELN("DIAGNOSIS INFORMATION")
+222 SET ICD=0
FOR
SET ICD=$ORDER(ICDINFO(ICD))
if 'ICD
QUIT
Begin DoDot:2
+223 SET ICDZ=ICDINFO(ICD)
+224 WRITE !,$SELECT($PIECE(ICDZ,"^")="P":"Primary",1:"Secondary")_" Dx:"
+225 WRITE !,$PIECE(ICDZ,"^",2)_" "_$PIECE(ICDZ,"^",3)
+226 WRITE !,$PIECE(ICDZ,"^",4)
+227 IF $ORDER(ICDINFO(ICD))
WRITE !,DDOT
End DoDot:2
End DoDot:1
+228 ;
+229 KILL ^TMP("PSOERX1C",$JOB)
MERGE ^TMP("PSOERX1C",$JOB)=@VALMAR
+230 WRITE !!,"eRx Reference #: ",$$GET1^DIQ(52.49,PSOIEN,.01,"E")," Message ID: ",$$GET1^DIQ(52.49,PSOIEN,25,"E")
+231 WRITE LTXT
SET LTXT=""
+232 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+233 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+234 ;;BEGIN TEST
+235 IF MTYPE="CA"!(MTYPE="RR")
Begin DoDot:1
+236 SET LINE=1
KILL @VALMAR
+237 IF MTYPE="CA"
DO CANREQ^PSOERXU5(CANREQ,.LINE,1)
DO CANRES^PSOERXU5(CANREQ,.LINE,1)
DO MSGHIS^PSOERXU3(CANREQ,.LINE)
+238 IF MTYPE="RR"
Begin DoDot:2
+239 IF S2017
DO MEDDIS^PSOERXU7(CANREQ,.LINE)
+240 IF 'S2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+241 DO RRREQ^PSOERXU3(CANREQ,.LINE)
DO RRRES^PSOERXU3(CANREQ,.LINE)
DO MSGHIS^PSOERXU3(CANREQ,.LINE)
End DoDot:2
+242 SET LOOP=0
FOR
SET LOOP=$ORDER(@VALMAR@(LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+243 WRITE !,$GET(@VALMAR@(LOOP,0))
End DoDot:2
+244 KILL @VALMAR
End DoDot:1
+245 IF MTYPE="CN"!(MTYPE="RE")
Begin DoDot:1
+246 SET LINE=1
KILL @VALMAR
+247 IF MTYPE="CN"
DO CANRES^PSOERXU5(CANRES,.LINE,1)
DO CANREQ^PSOERXU5(CANRES,.LINE,1)
DO MSGHIS^PSOERXU3(CANRES,.LINE)
+248 IF MTYPE="RE"
Begin DoDot:2
+249 SET R2017=$$GET1^DIQ(52.49,CANREQ,312.1,"I")
+250 IF 'S2017
IF 'R2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+251 IF S2017
IF 'R2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+252 IF S2017
IF R2017
DO MEDDIS^PSOERXU7(CANREQ,.LINE)
+253 DO RRRES^PSOERXU3(CANRES,.LINE)
DO RRREQ^PSOERXU3(CANRES,.LINE)
DO MSGHIS^PSOERXU3(CANRES,.LINE)
+254 SET LOOP=0
FOR
SET LOOP=$ORDER(@VALMAR@(LOOP))
if 'LOOP
QUIT
Begin DoDot:3
+255 WRITE !,$GET(@VALMAR@(LOOP,0))
End DoDot:3
+256 KILL @VALMAR
End DoDot:2
End DoDot:1
+257 IF ",CX,CR,"[(","_MTYPE_",")
Begin DoDot:1
+258 DO CHGEND^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
End DoDot:1
+259 WRITE !,$$TITLELN("END OF eRx")
+260 KILL @VALMAR
MERGE @VALMAR=^TMP("PSOERX1C",$JOB)
KILL ^TMP("PSOERX1C",$JOB)
+261 if '$DATA(ZTQUEUED)
DO ^%ZISC
+262 QUIT
+263 ;
TITLELN(TITLE) ; Title Line (Formats with _ around it, centered)
+1 NEW TITLELN
+2 SET $PIECE(TITLELN,"*",81)=""
+3 SET $EXTRACT(TITLELN,(82-$LENGTH(TITLE))\2,(82-$LENGTH(TITLE))\2+$LENGTH(TITLE)-1)=TITLE
+4 QUIT TITLELN
+5 ;
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
