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,770**;DEC 1997;Build 145
;
Q
; select an item
PRINT(PSOIEN,OP) ;
N %ZIS,POP,DIR,PSOQ
S OP=$G(OP)
S PSOQ=0
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 REFSCRN
D PRINTQ(PSOIEN,OP)
I '$G(PSOQ) K DIR S DIR(0)="E" D ^DIR K DIR
D TERM^VALM0
D REFSCRN
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 IOINHI=$G(IOINHI),IOINORM=$G(IOINORM),IOUON=$G(IOUON),IOUOFF=$G(IOUOFF),IORVON=$G(IORVON),IORVOFF=$G(IORVOFF)
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")
;
I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
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=""
I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
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)
I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
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
I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
W !,$$TITLELN("PRESCRIPTION INFORMATION")
Q:$$SHORTPI^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
W !,"Prescriber Order #: "_$$GET1^DIQ(52.49,PSOIEN,.09)
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
;
I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
;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
. . I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
;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
. . I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
;
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 Q:$G(PSOQ)
..I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
..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 Q:$G(PSOQ)
...I '$D(ZTQUEUED),$Y>(IOSL-7) D PAUSE(.PSOQ) Q:$G(PSOQ)
...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,"*",75)=""
S $E(TITLELN,(76-$L(TITLE))\2,(76-$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
;
REFSCRN ;refresh the screen
I $G(PRINTFLG)="VP" D HDR^PSOERXP1,INIT^PSOERXP1 Q ;Called from Validate Patient
I $G(PRINTFLG)="VM" D HDR^PSOERXR1,INIT^PSOERXR1 Q ;Called from Validate Provider
I $G(PRINTFLG)="VD" D HDR^PSOERXD1,INIT^PSOERXD1 Q ;Called from Validate Drug
I $G(OP) Q ;called from PSO ERX OP PRINT
D REF^PSOERSE1 ;the main PRINT
Q
;
PAUSE(PSOQ) ; pause screen display
; Input:
; PSOQ - var used to quit report processing to user CRT
; Output:
; PSOQ - passed by reference - 0 = Continue, 1 = Quit
;
N TRM,XX,I
S TRM=($E(IOST)="C")
I TRM D
. K DIR S DIR(0)="E" D ^DIR K DIR
. S:+Y=0 PSOQ=1
. F I=1:1:43 W $C(8)
. S $P(XX," ",43)="" W XX
. F I=1:1:43 W $C(8)
W #
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1C 14199 printed Sep 23, 2025@20:04:36 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,770**;DEC 1997;Build 145
+2 ;
+3 QUIT
+4 ; select an item
PRINT(PSOIEN,OP) ;
+1 NEW %ZIS,POP,DIR,PSOQ
+2 SET OP=$GET(OP)
+3 SET PSOQ=0
+4 DO FULL^VALM1
+5 SET VALMBCK="R"
+6 SET %ZIS="Q"
SET %ZIS("B")=$GET(PSOPROP)
DO ^%ZIS
if POP
QUIT
+7 ; if queuing, queue it and quit.
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTSAVE("PSOIEN")=""
SET ZTSAVE("OP")=""
SET ZTSAVE("VALMAR")=""
SET ZTSAVE("VALMEVL")=""
+10 SET ZTRTN="PRINTQ^PSOERX1C(PSOIEN,OP)"
SET ZTDESC="eRx Print"
DO ^%ZTLOAD
+11 KILL ZTSAVE,ZTRTN
+12 DO TERM^VALM0
+13 DO REFSCRN
End DoDot:1
QUIT
+14 DO PRINTQ(PSOIEN,OP)
+15 IF '$GET(PSOQ)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+16 DO TERM^VALM0
+17 DO REFSCRN
+18 QUIT
+19 ; 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 IOINHI=$GET(IOINHI)
SET IOINORM=$GET(IOINORM)
SET IOUON=$GET(IOUON)
SET IOUOFF=$GET(IOUOFF)
SET IORVON=$GET(IORVON)
SET IORVOFF=$GET(IORVOFF)
+7 SET OP=$GET(OP,"")
+8 SET PSOIEN=$GET(PSOIEN)
+9 IF '$GET(PSOIEN)
Begin DoDot:1
+10 IF $DATA(RXOR)
SET PSOIEN=$$CHKERX^PSOERXU1($PIECE(RXOR,U,2))
if PSOIEN
QUIT
+11 IF $DATA(OR0)
SET PSOIEN=$$CHKERX^PSOERXU1(OR0)
End DoDot:1
+12 if '$GET(PSOIEN)
QUIT
+13 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+14 SET CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
+15 SET CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
+16 SET RESPVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
+17 IF MTYPE="CN"!(MTYPE="RE")!(MTYPE="IE")
Begin DoDot:1
+18 SET CANRES=PSOIEN
+19 SET CANREQ=$$GETREQ^PSOERXU2(PSOIEN)
+20 IF $GET(CANREQ)
Begin DoDot:2
+21 SET NEWRXIEN=$$RESOLV^PSOERXU2(CANREQ)
+22 ; if there is no NewRx related to this request, pull the data from the cancel request itself.
+23 IF '$PIECE(NEWRXIEN,U)
SET NEWRXIEN=$GET(CANREQ)
End DoDot:2
End DoDot:1
+24 IF MTYPE="CA"!(MTYPE="RR")
Begin DoDot:1
+25 SET CANREQ=PSOIEN
SET CANRES=$$GETRESP^PSOERXU2(CANREQ)
+26 SET NEWRXIEN=$$RESOLV^PSOERXU2(CANREQ)
+27 IF '$PIECE(NEWRXIEN,U)
SET NEWRXIEN=$GET(CANREQ)
End DoDot:1
+28 ; if we found the newrxien because of a different message type, reset PSOIEN to pull rx info from the newrx.
+29 SET S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
+30 IF S2017
Begin DoDot:1
+31 IF MTYPE'="RE"
Begin DoDot:2
+32 SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","P",0))
End DoDot:2
+33 IF MTYPE="RE"
Begin DoDot:2
+34 SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","MR",0))
End DoDot:2
End DoDot:1
+35 SET PSOIENS=PSOIEN_","
+36 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+37 USE IO
+38 DO GETS^DIQ(52.49,PSOIENS,".04;.08;2.1;2.5","I","RXDAT")
+39 SET PHARIEN=$GET(RXDAT(52.49,PSOIENS,2.5,"I"))
+40 if PHARIEN
SET PHARIENS=PHARIEN_","
+41 SET PRVIEN=$GET(RXDAT(52.49,PSOIENS,2.1,"I"))
+42 if PRVIEN
SET PRVIENS=PRVIEN_","
+43 SET PATIEN=$GET(RXDAT(52.49,PSOIENS,.04,"I"))
+44 if PATIEN
SET PATIENS=PATIEN_","
+45 IF $DATA(PHARIENS)
DO GETS^DIQ(52.47,PHARIENS,"**","E","PHARDAT")
+46 IF $DATA(PRVIENS)
DO GETS^DIQ(52.48,PRVIENS,"**","E","PRVDAT")
+47 IF $DATA(PATIENS)
DO GETS^DIQ(52.46,PATIENS,"**","E","PATDAT")
+48 ; pharmacy information
+49 IF $DATA(PHARIENS)
Begin DoDot:1
+50 SET PHNM=$GET(PHARDAT(52.47,PHARIENS,.05,"E"))
+51 SET PHAD1=$GET(PHARDAT(52.47,PHARIENS,1.1,"E"))
+52 SET PHAD2=$GET(PHARDAT(52.47,PHARIENS,1.2,"E"))
+53 SET PHCTY=$GET(PHARDAT(52.47,PHARIENS,1.3,"E"))
+54 SET PHST=$GET(PHARDAT(52.47,PHARIENS,1.4,"E"))
+55 SET PHZIP=$GET(PHARDAT(52.47,PHARIENS,1.5,"E"))
+56 IF S2017
Begin DoDot:2
+57 SET PHNCP=$GET(PHARDAT(52.47,PHARIENS,10.1,"E"))
+58 ; Add extension
SET PHTEL=$$COMMVAL^PSOERXU5(PHARIEN,52.47,7,"PT",1)
End DoDot:2
+59 IF 'S2017
Begin DoDot:2
+60 SET PHNCP=$GET(PHARDAT(52.47,PHARIENS,.02,"E"))
+61 SET PHTEL=$$COMMVAL^PSOERXU5(PHARIEN,52.47,7,"PT",1)
End DoDot:2
End DoDot:1
+62 ; provider information
+63 IF $DATA(PRVIENS)
Begin DoDot:1
+64 SET PRFNM=$GET(PRVDAT(52.48,PRVIENS,.03,"E"))
+65 SET PRMNM=$GET(PRVDAT(52.48,PRVIENS,.04,"E"))
+66 SET PRLNM=$GET(PRVDAT(52.48,PRVIENS,.02,"E"))
+67 SET PRAD1=$GET(PRVDAT(52.48,PRVIENS,4.1,"E"))
+68 SET PRAD2=$GET(PRVDAT(52.48,PRVIENS,4.2,"E"))
+69 SET PRCTY=$GET(PRVDAT(52.48,PRVIENS,4.3,"E"))
+70 SET PRST=$GET(PRVDAT(52.48,PRVIENS,4.4,"E"))
+71 SET PRZIP=$GET(PRVDAT(52.48,PRVIENS,4.5,"E"))
+72 IF S2017
Begin DoDot:2
+73 SET PRNPI=$GET(PRVDAT(52.48,PRVIENS,15.1,"E"))
+74 SET PRDEA=$GET(PRVDAT(52.48,PRVIENS,14.5,"E"))
+75 SET PRSTL=$GET(PRVDAT(52.48,PRVIENS,14.1,"E"))
End DoDot:2
+76 IF 'S2017
Begin DoDot:2
+77 SET PRNPI=$GET(PRVDAT(52.48,PRVIENS,1.5,"E"))
+78 SET PRDEA=$GET(PRVDAT(52.48,PRVIENS,1.6,"E"))
+79 SET PRSTL=$GET(PRVDAT(52.48,PRVIENS,1.8,"E"))
End DoDot:2
+80 IF '$GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,PSOIEN,2.6,"E")
+81 IF $GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,NEWRXIEN,2.6,"E")
+82 SET PRAGNTFN=$$GET1^DIQ(52.48,PRVIEN,5.2,"E")
+83 SET PRAGNTMN=$$GET1^DIQ(52.48,PRVIEN,5.3,"E")
+84 SET PRAGNTLN=$$GET1^DIQ(52.48,PRVIEN,5.1,"E")
+85 IF S2017
Begin DoDot:2
+86 ; Add extension
SET PRTEL=$$COMMVAL^PSOERXU5(PRVIEN,52.48,11,"PT",1)
+87 ; Add extension
SET PRFAX=$$COMMVAL^PSOERXU5(PRVIEN,52.48,11,"F",1)
End DoDot:2
+88 IF 'S2017
Begin DoDot:2
+89 SET SIEN=0
+90 FOR
SET SIEN=$ORDER(^PS(52.48,PRVIEN,3,SIEN))
if 'SIEN
QUIT
Begin DoDot:3
+91 SET IENS=SIEN_","_PRVIEN_","
+92 SET TYPE=$$GET1^DIQ(52.483,IENS,.02)
+93 SET VALUE=$$GET1^DIQ(52.483,IENS,.01)
+94 Begin DoDot:4
+95 IF TYPE="FAX"
SET PRFAX=VALUE
QUIT
+96 IF TYPE="TELEPHONE"
SET PRTEL=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+97 IF '$DATA(PRVIENS)
Begin DoDot:1
+98 SET (PRFNM,PRMNM,PRLNM,PRAD1,PRAD2,PRCTY,PRST,PRZIP)=""
+99 SET (PRNPI,PRDEA,PRSTL)=""
+100 IF '$GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,PSOIEN,2.6,"E")
+101 IF $GET(NEWRXIEN)
SET PRSUPER=$$GET1^DIQ(52.49,NEWRXIEN,2.6,"E")
+102 SET (PRAGNTFN,PRAGNTMN,PRAGNTLN)=""
+103 SET (PRTEL,PRFAX)=""
End DoDot:1
+104 SET CLINIC=$$GET1^DIQ(52.48,PRVIEN,18.6)
+105 ; patient information
+106 IF $DATA(PATIENS)
Begin DoDot:1
+107 SET PTLNM=$GET(PATDAT(52.46,PATIENS,.02,"E"))
+108 SET PTMNM=$GET(PATDAT(52.46,PATIENS,.04,"E"))
+109 SET PTFNM=$GET(PATDAT(52.46,PATIENS,.03,"E"))
+110 SET PTAD1=$GET(PATDAT(52.46,PATIENS,3.1,"E"))
+111 SET PTAD2=$GET(PATDAT(52.46,PATIENS,3.2,"E"))
+112 SET PTCTY=$GET(PATDAT(52.46,PATIENS,3.3,"E"))
+113 SET PTST=$GET(PATDAT(52.46,PATIENS,3.4,"E"))
+114 SET PTZIP=$GET(PATDAT(52.46,PATIENS,3.5,"E"))
+115 SET PTDOB=$GET(PATDAT(52.46,PATIENS,.08,"E"))
+116 SET PTGEN=$GET(PATDAT(52.46,PATIENS,.07,"E"))
+117 SET PTSSN=$GET(PATDAT(52.46,PATIENS,$SELECT(S2017:18.2,1:1.4),"E"))
+118 SET PTHPHON=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
End DoDot:1
+119 ;
+120 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
+121 WRITE !,$$TITLELN("PHARMACY INFORMATION")
+122 IF MTYPE="RR"
Begin DoDot:1
+123 NEW NEWRXIEN
+124 SET NEWRXIEN=$$RESOLV^PSOERXU2(PSOIEN)
+125 if NEWRXIEN
SET PHNCP=$$GET1^DIQ(52.49,NEWRXIEN,22.3)
End DoDot:1
+126 IF $DATA(PHARIENS)
Begin DoDot:1
+127 WRITE !,$$UP^XLFSTR(PHNM)
+128 WRITE !,"Address: "_PHAD1
+129 if $LENGTH(PHAD2)
WRITE !," "_PHAD2
+130 WRITE !," "_PHCTY_", "_PHST_" "_PHZIP
+131 SET LTXT=""
+132 DO ADDITEM^PSOERX1A(.LTXT,"Primary Phone: ",PHTEL,1,40)
+133 DO ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",PHNCP,42,26)
+134 WRITE !,LTXT
SET LTXT=""
End DoDot:1
+135 IF '$DATA(PHARIENS)
Begin DoDot:1
+136 WRITE !,"Recipient pharmacy name and address missing."
+137 SET LTXT=""
+138 DO ADDITEM^PSOERX1A(.LTXT,"NCPDP: ",$GET(PHNCP),1,26)
+139 WRITE !!,LTXT
SET LTXT=""
End DoDot:1
+140 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
+141 WRITE !,$$TITLELN("PRESCRIBER INFORMATION")
+142 WRITE !,"Name: "_PRLNM_", "_PRFNM_" "_PRMNM
+143 IF $GET(CLINIC)'=""
WRITE !,"Clinic: ",CLINIC
+144 WRITE !,"Address: "_PRAD1
+145 IF $LENGTH(PRAD2)
WRITE !," "_PRAD2
+146 WRITE !," "_PRCTY_", "_PRST_" "_PRZIP
+147 WRITE !,"NPI: "_PRNPI,?20,"DEA: "_PRDEA,?40,"State Lic: "_PRSTL
+148 WRITE !,"Primary Phone: "_$GET(PRTEL),?40,"Fax: "_$GET(PRFAX)
+149 IF $GET(PRSUPER)'=""!($GET(PRAGNTLN)'="")
WRITE !,"Supervisor: "_$GET(PRSUPER)
if $GET(PRAGNTLN)'=""
WRITE ?45,"Agent: "_$GET(PRAGNTLN)_", "_$GET(PRAGNTFN)_" "_$GET(PRAGNTMN)
+150 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
+151 WRITE !,$$TITLELN("PATIENT INFORMATION")
+152 SET LTXT=""
+153 IF $DATA(PATIENS)
Begin DoDot:1
+154 WRITE !,"Name: "_PTLNM_", "_PTFNM_" "_PTMNM
+155 WRITE !,"DOB: ",PTDOB,?19,"Sex: ",PTGEN,?33,"Primary Phone: ",PTHPHON,?64,"SSN: ",PTSSN
+156 WRITE !,"Address: "_PTAD1
+157 IF $LENGTH(PTAD2)
WRITE !," "_PTAD2
+158 WRITE !," "_PTCTY_", "_PTST_" "_PTZIP
+159 SET LTXT=""
End DoDot:1
+160 IF S2017
Begin DoDot:1
+161 SET PHW=$$BHW^PSOERXIU(PSOIEN)
WRITE !,PHW
End DoDot:1
+162 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
+163 WRITE !,$$TITLELN("PRESCRIPTION INFORMATION")
+164 if $$SHORTPI^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
QUIT
+165 WRITE !,"Prescriber Order #: "_$$GET1^DIQ(52.49,PSOIEN,.09)
+166 WRITE !,"eRx Drug: "_$$GET1^DIQ(52.49,PSOIEN,3.1,"E")_" "_$PIECE($$ERXDRSCH^PSOERXUT(+PSOIENS),"^",2)
+167 WRITE !,$$DRUGCODE(PSOIEN,+$GET(MEDIEN))
+168 SET ERXWDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
+169 IF 'S2017
WRITE ?20,"Written Date: "_$$FMTE^XLFDT(ERXWDATE,"2D")
+170 IF S2017
Begin DoDot:1
+171 SET ERXEFFDT=$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN)
+172 WRITE ?20,"Written Date: "_$$FMTE^XLFDT($PIECE(ERXWDATE,"."),1)_" Issue Date: "_ERXEFFDT
End DoDot:1
+173 WRITE !,"Qty: ",$$GET1^DIQ(52.49,PSOIEN,5.1,"E"),?20,"Days Supply: ",$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
+174 IF S2017
Begin DoDot:1
+175 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+176 ;setting 10.6 refill value
End DoDot:1
+177 IF 'S2017
Begin DoDot:1
+178 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+179 IF REFILL=""
Begin DoDot:2
+180 SET REFILL=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
End DoDot:2
End DoDot:1
+181 ; refills for a refill response is # of refills-1
+182 IF MTYPE="RE"
IF REFILL
SET REFILL=REFILL-1
+183 WRITE ?45,"Refills: "_REFILL
+184 IF 'S2017
WRITE !,"Code List Qualifier: "_$$GET1^DIQ(52.49,PSOIEN,5.2,"E")
+185 IF S2017
Begin DoDot:1
+186 NEW ERXQQ
+187 SET ERXQQ=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",2.2,"I")
SET ERXQQ=$$GET1^DIQ(52.45,ERXQQ,.02,"E")
+188 WRITE !,"Code List Qualifier: "_ERXQQ
End DoDot:1
+189 WRITE !,"Drug Form: "_$$GET1^DIQ(52.49,PSOIEN,41,"E")
+190 WRITE !,"Strength: "_$$GET1^DIQ(52.49,PSOIEN,43,"E")
+191 SET EXSTATUS=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+192 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+193 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+194 WRITE !,"Substitutions?: "_ERXDSUB
+195 IF S2017
Begin DoDot:1
+196 IF MTYPE="N"!((MTYPE="CX")&($$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI)))
Begin DoDot:2
+197 SET PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
+198 SET PROHIBIT=$SELECT(PROHIBIT=1:"Yes",1:"No")
+199 WRITE ?30,"Prohibit Renewals: "_PROHIBIT
End DoDot:2
End DoDot:1
+200 IF 'S2017
WRITE !,"SIG: "_$$GET1^DIQ(52.49,PSOIEN,7,"E")
+201 IF S2017
Begin DoDot:1
+202 WRITE !,"eRx Sig:"
+203 if $GET(MEDIEN)=""
QUIT
+204 SET SGLOOP=0
FOR
SET SGLOOP=$ORDER(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP))
if 'SGLOOP
QUIT
Begin DoDot:2
+205 WRITE !,$GET(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0))
End DoDot:2
End DoDot:1
+206 SET PRVNOTES=$$GET1^DIQ(52.49,PSOIEN,8)
+207 IF PRVNOTES'=""
WRITE !,"Provider Comments: ",PRVNOTES
+208 ;
+209 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
+210 ;Prescriber Drug Use Evaluation
+211 DO PDUEDATA^PSOERXU9(.DUEINFO,PSOIEN,1)
+212 IF $DATA(DUEINFO)
Begin DoDot:1
+213 SET $PIECE(DDOT,".",81)=""
+214 WRITE !,$$TITLELN("PRESCRIBER DRUG USE EVALUATION")
+215 SET DUECNT=0
FOR
SET DUECNT=$ORDER(DUEINFO(DUECNT))
if 'DUECNT
QUIT
Begin DoDot:2
+216 WRITE !,"Co-Agent: "_$PIECE(DUEINFO(DUECNT),"^",8)
+217 SET REASON=$PIECE(DUEINFO(DUECNT),"^",2)
IF $$PRESOLV^PSOERXA1(REASON,"REA")
SET REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
+218 WRITE !,"Reason: "_REASON
+219 SET RESULT=$PIECE(DUEINFO(DUECNT),"^",4)
IF $$PRESOLV^PSOERXA1(RESULT,"RES")
SET RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
+220 WRITE !,"Result: "_RESULT
+221 WRITE !,"Override: "_$PIECE(DUEINFO(DUECNT),"^",9)
+222 IF $ORDER(DUEINFO(DUECNT))
WRITE !,DDOT
+223 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
End DoDot:2
End DoDot:1
+224 ;Diagnosis Code
+225 DO GETDIAGS^PSOERUT3(PSOIEN,.ICDINFO)
+226 IF $DATA(ICDINFO)
Begin DoDot:1
+227 SET $PIECE(DDOT,".",81)=""
+228 WRITE !,$$TITLELN("DIAGNOSIS INFORMATION")
+229 SET ICD=0
FOR
SET ICD=$ORDER(ICDINFO(ICD))
if 'ICD
QUIT
Begin DoDot:2
+230 SET ICDZ=ICDINFO(ICD)
+231 WRITE !,$SELECT($PIECE(ICDZ,"^")="P":"Primary",1:"Secondary")_" Dx:"
+232 WRITE !,$PIECE(ICDZ,"^",2)_" "_$PIECE(ICDZ,"^",3)
+233 WRITE !,$PIECE(ICDZ,"^",4)
+234 IF $ORDER(ICDINFO(ICD))
WRITE !,DDOT
+235 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
End DoDot:2
End DoDot:1
+236 ;
+237 KILL ^TMP("PSOERX1C",$JOB)
MERGE ^TMP("PSOERX1C",$JOB)=@VALMAR
+238 WRITE !!,"eRx Reference #: ",$$GET1^DIQ(52.49,PSOIEN,.01,"E")," Message ID: ",$$GET1^DIQ(52.49,PSOIEN,25,"E")
+239 WRITE LTXT
SET LTXT=""
+240 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+241 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+242 ;;BEGIN TEST
+243 IF MTYPE="CA"!(MTYPE="RR")
Begin DoDot:1
+244 SET LINE=1
KILL @VALMAR
+245 IF MTYPE="CA"
DO CANREQ^PSOERXU5(CANREQ,.LINE,1)
DO CANRES^PSOERXU5(CANREQ,.LINE,1)
DO MSGHIS^PSOERXU3(CANREQ,.LINE)
+246 IF MTYPE="RR"
Begin DoDot:2
+247 IF S2017
DO MEDDIS^PSOERXU7(CANREQ,.LINE)
+248 IF 'S2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+249 DO RRREQ^PSOERXU3(CANREQ,.LINE)
DO RRRES^PSOERXU3(CANREQ,.LINE)
DO MSGHIS^PSOERXU3(CANREQ,.LINE)
End DoDot:2
+250 SET LOOP=0
FOR
SET LOOP=$ORDER(@VALMAR@(LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+251 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
+252 WRITE !,$GET(@VALMAR@(LOOP,0))
End DoDot:2
if $GET(PSOQ)
QUIT
+253 KILL @VALMAR
End DoDot:1
+254 IF MTYPE="CN"!(MTYPE="RE")
Begin DoDot:1
+255 SET LINE=1
KILL @VALMAR
+256 IF MTYPE="CN"
DO CANRES^PSOERXU5(CANRES,.LINE,1)
DO CANREQ^PSOERXU5(CANRES,.LINE,1)
DO MSGHIS^PSOERXU3(CANRES,.LINE)
+257 IF MTYPE="RE"
Begin DoDot:2
+258 SET R2017=$$GET1^DIQ(52.49,CANREQ,312.1,"I")
+259 IF 'S2017
IF 'R2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+260 IF S2017
IF 'R2017
DO MEDDIS^PSOERXU3(CANREQ,"D",.LINE)
+261 IF S2017
IF R2017
DO MEDDIS^PSOERXU7(CANREQ,.LINE)
+262 DO RRRES^PSOERXU3(CANRES,.LINE)
DO RRREQ^PSOERXU3(CANRES,.LINE)
DO MSGHIS^PSOERXU3(CANRES,.LINE)
+263 SET LOOP=0
FOR
SET LOOP=$ORDER(@VALMAR@(LOOP))
if 'LOOP
QUIT
Begin DoDot:3
+264 IF '$DATA(ZTQUEUED)
IF $Y>(IOSL-7)
DO PAUSE(.PSOQ)
if $GET(PSOQ)
QUIT
+265 WRITE !,$GET(@VALMAR@(LOOP,0))
End DoDot:3
if $GET(PSOQ)
QUIT
+266 KILL @VALMAR
End DoDot:2
End DoDot:1
+267 IF ",CX,CR,"[(","_MTYPE_",")
Begin DoDot:1
+268 DO CHGEND^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
End DoDot:1
+269 WRITE !,$$TITLELN("END OF eRx")
+270 KILL @VALMAR
MERGE @VALMAR=^TMP("PSOERX1C",$JOB)
KILL ^TMP("PSOERX1C",$JOB)
+271 if '$DATA(ZTQUEUED)
DO ^%ZISC
+272 QUIT
+273 ;
TITLELN(TITLE) ; Title Line (Formats with _ around it, centered)
+1 NEW TITLELN
+2 SET $PIECE(TITLELN,"*",75)=""
+3 SET $EXTRACT(TITLELN,(76-$LENGTH(TITLE))\2,(76-$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
+7 ;
REFSCRN ;refresh the screen
+1 ;Called from Validate Patient
IF $GET(PRINTFLG)="VP"
DO HDR^PSOERXP1
DO INIT^PSOERXP1
QUIT
+2 ;Called from Validate Provider
IF $GET(PRINTFLG)="VM"
DO HDR^PSOERXR1
DO INIT^PSOERXR1
QUIT
+3 ;Called from Validate Drug
IF $GET(PRINTFLG)="VD"
DO HDR^PSOERXD1
DO INIT^PSOERXD1
QUIT
+4 ;called from PSO ERX OP PRINT
IF $GET(OP)
QUIT
+5 ;the main PRINT
DO REF^PSOERSE1
+6 QUIT
+7 ;
PAUSE(PSOQ) ; pause screen display
+1 ; Input:
+2 ; PSOQ - var used to quit report processing to user CRT
+3 ; Output:
+4 ; PSOQ - passed by reference - 0 = Continue, 1 = Quit
+5 ;
+6 NEW TRM,XX,I
+7 SET TRM=($EXTRACT(IOST)="C")
+8 IF TRM
Begin DoDot:1
+9 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+10 if +Y=0
SET PSOQ=1
+11 FOR I=1:1:43
WRITE $CHAR(8)
+12 SET $PIECE(XX," ",43)=""
WRITE XX
+13 FOR I=1:1:43
WRITE $CHAR(8)
End DoDot:1
+14 WRITE #
+15 QUIT
+16 ;
