PSOORNE2 ;BIR/SAB-display finished orders from backdoor ;19-May-2014 12:16;DU
;;7.0;OUTPATIENT PHARMACY;**11,21,23,27,32,37,46,84,103,117,131,146,1004,1008,156,210,148,222,238,264,281,289,1015,1016,1017,1018**;DEC 1997;Build 21
;^PSDRUG( - 221
;^YSCL(603.01 - 2697
;^PS(50.606 - 2174
;^PS(50.7 - 2223
;PSO*210 add call to WORDWRAP api
;$$DAWEXT^PSSDAWUT - 4708
;
; Modified - IHS/CIA/PLS - 01/15/04 - Lines PTST+30
; Modified - IHS/CIA/PLS - 02/24/06 - Line PTST+23
; IHS/MSC/PLS - 03/13/08 - Line PTST+49 Substitution
; 01/23/09 - Line PTST+50 Cash Due
; 03/21/13 - Line PTST+54
; IHS/MSC/PB 08/03/12 - Line tag SIGN added at line PST+2 to pull the SIGNS and SYMPTOMS and the INDICATION CODES for display
; IHS/MSC/PLS 06/04/13 - Added Discharge Medication
; 05/19/14 - Added ACT+3
SEL N ORN,ORD I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
D K1^PSOORNE6 S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR I $D(DIRUT) D KV^PSOVER1 S VALMBCK="" Q
NEWSEL N ORN,ORD D K2^PSOORNE6
I +Y S PSOOELSE=1,PSLST=Y K PSOREEDT D
.F ORD=1:1:$L(PSLST,",") Q:$P(PSLST,",",ORD)']"" S ORN=+$P(PSLST,",",ORD) D @$S(+PSOLST(ORN)=52:"ACT",1:"PEN^PSOORNE5") K PSOREEDT,PSOSIGFL,PSONACT,SIGOK,PSOFDR,DRET,SIG,INS1 D UL1 I $G(PSOQUIT) K PSOQUIT Q
K PRC,PHI,RTE I '$G(PSOOELSE) S VALMBCK=""
K PSONACT,PSOOELSE,CLOZPAT D ^PSOBUILD,BLD^PSOORUT1,K3^PSOORNE6
Q
;
ACT N REF K ^TMP("PSOAO",$J),PCOMX,PDA,PHI,PRC,ACOM,ANS,PSOFDR,CLOZPAT,ANQREM,DUR,DRET
S RXN=$P(PSOLST(ORN),"^",2),RX0=^PSRX(RXN,0),RX2=$G(^(2)),RX3=$G(^(3)),ST=+$G(^("STA")),RXOR=$G(^("OR1")),POE=$G(^("POE")),EXDT=$S($P($G(^(2)),"^",6)>DT:1,1:0)
I 'RX3 S RX3=$P(RX2,"^",2),$P(^PSRX(RXN,3),"^")=$P(RX2,"^",2)
;IHS/MSC/PLS - 05/19/2014
I $$GET1^DIQ(52,$G(RXN),9999999.23,"I") S VALMSG="AUTOFINISHED prescriptions are not editable.",VALMBCK="" Q
S PSODRG=+$P(RX0,"^",6),PSODRUG0=^PSDRUG(PSODRG,0),INDT=$G(^("I"))
;PSO*7*238;SET PSODRUG ARRAY ; PSOY KILLED AT END OF SET^PSODRG
K PSODRUG
S PSOY=PSODRG,PSOY(0)=PSODRUG0 D SET^PSODRG
I 'RXOR,$P(^PSDRUG(PSODRG,2),"^") S $P(^PSRX(RXN,"OR1"),"^")=$P(^PSDRUG(PSODRG,2),"^"),RXOR=$P(^PSDRUG(PSODRG,2),"^")
I $P($G(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1" D
.S CLOZPAT=$O(^YSCL(603.01,"C",PSODFN,0)) Q:'CLOZPAT
.;S CLOZPAT=$S($P(^YSCL(603.01,CLOZPAT,0),"^",3)="B":1,1:0)
.S CLOZPAT=$P(^YSCL(603.01,CLOZPAT,0),"^",3)
.S CLOZPAT=$S(CLOZPAT="M":2,CLOZPAT="B":1,1:0)
I $D(^XUSEC("PSORPH",DUZ)) S RPH=1 D
.S PSOACT=$S('ST&($G(INDT)]"")&(DT>$G(INDT)):"DHPLATC",ST=1:"DVE",ST=4:"DV",ST=3:"DU",ST=5:"ELTD",ST=11:"ETDPCL",ST=12&EXDT:"EDCL",ST=12&'EXDT:"ECL",(ST=14!(ST=15))&'EXDT:"ECL",ST=13:"L",ST=16:"DL",1:"DHPEATCL")
.D GET^PSOORNE5 S PSOACT=PSOACT_$S(ACTREN:"N",1:""),PSOACT=PSOACT_$S(ACTREF:"R",1:"")
.I ST=5 S SURX=$O(^PS(52.5,"B",RXN,0)) I SURX,$P($G(^PS(52.5,SURX,0)),"^",7)="L" S PSOACT="TL" K SURX Q
.S:ST'=12&('$D(^PS(50.7,+$P(RXOR,"^"),0))) PSOACT="DL",VALMSG="No Pharmacy Orderable Item !",PSONACT=1
.S:ST=12&('$D(^PS(50.7,+$P(RXOR,"^"),0))) PSOACT="L",VALMSG="No Pharmacy Orderable Item !",PSONACT=1
.;I ST=14!(ST=15) S VALMSG="Rx Discontinued By "_$S(ST=14:"Provider",1:"Edit")_". Cannot be Reinstated."
.S:ST=16 VALMSG="Rx Placed on HOLD by Provider."
E D
.I ST=5 S SURX=$O(^PS(52.5,"B",RXN,0)) I SURX,$P($G(^PS(52.5,SURX,0)),"^",7)="L" S PSOACT="TL" Q
.S PSOACT=$S(ST'<1&(ST'>4)!(ST>12):"",ST=12&EXDT&($P($G(PSOPAR),"^",2)):"CDPLT",1:"CPLT")
.D GET^PSOORNE5 S PSOACT=PSOACT_$S(ACTREN:"N",1:""),PSOACT=PSOACT_$S(ACTREF:"R",1:"")
.S:'$D(^PS(50.7,+$P(RXOR,"^"),0)) PSOACT="L",PSONACT=1,VALMSG="No Pharmacy Orderable Item !"
;K PSOLKFL D PSOL^PSSLOCK(RXN) I '$G(PSOMSG) K PSOMSG S PSOLKFL=1 S PSOACT="",VALMSG="This Order is being edited by another user."
K PSOMSG S IEN=0,$P(RN," ",12)=" "
I $G(RPH),ST=1,$P($G(^PSRX(RXN,"PKI")),"^") N PKI,PKI1,PKIR,PKIE,DA S DA=RXN D CER^PSOPKIV1 K DA D:$G(PKI1) L1^PSOPKIV1
D DIN^PSONFI(+RXOR,$P(RX0,"^",6))
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=$S($P($G(^PSRX(RXN,"TPB")),"^"):" TPB Rx #: ",1:" Rx #: ")
S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_$P(RX0,"^")_$S($G(^PSRX(RXN,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXN)_$E(RN,$L($P(RX0,"^")_$S($G(^PSRX(RXN,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXN))+1,12)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" ("_$S($P(PSOPAR,"^",3):1,1:"#")_")"_" *Orderable Item: "_$S($D(^PS(50.7,$P(+RXOR,"^"),0)):$P(^PS(50.7,$P(+RXOR,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:"")_NFIO
S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOAO",$J,IEN,0))-4)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" ("_$S($P(PSOPAR,"^",3):2,1:"#")_")"_$S($D(^PSDRUG("AQ",$P(RX0,"^",6))):" CMOP ",1:" ")_"Drug: "_$P(^PSDRUG($P(RX0,"^",6),0),"^")_NFID
S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOAO",$J,IEN,0))-4)
I $$STATUS^PSOBPSUT(RXN,0)'="",$$RXRLDT^PSOBPSUT(RXN,0) D
. S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" "_$S('$P(PSOPAR,"^",3):"(2)",1:" ")_" NDC: "_$$GETNDC^PSONDCUT(RXN,0)
S:$G(^PSRX(RXN,"TN"))]"" IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Trade Name: "_$G(^PSRX(RXN,"TN"))
D DOSE^PSOORNE5
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" (4)Pat Instructions:" D INS^PSOORNE5
D PC^PSOORNE5
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" SIG:"
I '$P($G(^PSRX(RXN,"SIG")),"^",2) S SIGOK=0 D G PTST
.S X=$P($G(^PSRX(RXN,"SIG")),"^") D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
.F SG=1:1:$L(SIG) S:$L(^TMP("PSOAO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAO",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOAO",$J,IEN,0)=$G(^TMP("PSOAO",$J,IEN,0))_" "_$P(SIG," ",SG)
S SIGOK=1
F I=0:0 S I=$O(^PSRX(RXN,"SIG1",I)) Q:'I D ;PSO*210
. S MIG=$P(^PSRX(RXN,"SIG1",I,0),"^")
. D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAO",$J)),21)
S SIGOK=1 K MIG,SG
PTST ;
;IHS/MSC/PB - 08/03/12 Next line added to pull the SIGNS and SYMPTOMS and the INDICATION CODE for display
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Clinical Indication: "_$P($G(^PSRX(RXN,999999921)),"^",1)_" "_$P($G(^PSRX(RXN,999999921)),"^",2) ;IEN=IEN+1
S $P(RN," ",25)=" ",PTST=$S($G(^PS(53,+$P(RX0,"^",3),0))]"":$P($G(^PS(53,+$P(RX0,"^",3),0)),"^"),1:""),IEN=IEN+1
S ^TMP("PSOAO",$J,IEN,0)=" (5) Patient Status: "_PTST_$E(RN,$L(PTST)+1,25)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" (6) Issue Date: "_$E($P(RX0,"^",13),4,5)_"/"_$E($P(RX0,"^",13),6,7)_"/"_$E($P(RX0,"^",13),2,3)
S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" (7) Fill Date: "_$E($P(RX2,"^",2),4,5)_"/"_$E($P(RX2,"^",2),6,7)_"/"_$E($P(RX2,"^",2),2,3)
S ROU=$S($P(RX0,"^",11)="W":"Window",1:"Mail")
S REFL=$P(RX0,"^",9),I=0 F S I=$O(^PSRX(RXN,1,I)) Q:'I S REFL=REFL-1,ROU=$S($P(^PSRX(RXN,1,I,0),"^",2)="W":"Window",1:"Mail")
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Last Fill Date: "_$E($P(RX3,"^"),4,5)_"/"_$E($P(RX3,"^"),6,7)_"/"_$E($P(RX3,"^"),2,3)
D CMOP^PSOORNE3
S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" ("_ROU_$S($G(PSOCMOP)]"":", "_PSOCMOP,1:"")_")" K ROU,PSOCMOP
S IEN=IEN+1 I $P(RX2,"^",15) S ^TMP("PSOAO",$J,IEN,0)=" Returned to Stock: "_$E($P(RX2,"^",15),4,5)_"/"_$E($P(RX2,"^",15),6,7)_"/"_$E($P(RX2,"^",15),2,3)_$S($P(RX2,"^",14):" (Reprinted)",1:"")
E S ^TMP("PSOAO",$J,IEN,0)=" Last Release Date: " D
.S RLD=$S($P(RX2,"^",13):$E($P(RX2,"^",13),4,5)_"/"_$E($P(RX2,"^",13),6,7)_"/"_$E($P(RX2,"^",13),2,3),1:"")
.I $O(^PSRX(RXN,1,0)) F I=0:0 S I=$O(^PSRX(RXN,1,I)) Q:'I D
..I $P(^PSRX(RXN,1,I,0),"^",18) S RLD=$E($P(^(0),"^",18),4,5)_"/"_$E($P(^(0),"^",18),6,7)_"/"_$E($P(^(0),"^",18),2,3)
.S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_$S($G(RLD)]"":RLD,1:" ")
S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" (8) Lot #: "_$P($G(RX2),"^",4)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Expires: "_$E($P(RX2,"^",6),4,5)_"/"_$E($P(RX2,"^",6),6,7)_"/"_$E($P(RX2,"^",6),2,3)
S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" MFG: "_$P($G(RX2),"^",8)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(9) Days Supply: "_$P(RX0,"^",8)_$S($L($P(RX0,"^",8))=1:" ",1:"")
S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" (10) QTY"_$S($P($G(^PSDRUG($P(RX0,"^",6),660)),"^",8)]"":" ("_$P($G(^PSDRUG($P(RX0,"^",6),660)),"^",8)_")",1:" ( )")_": "_$P(RX0,"^",7)
I $P($G(^PSDRUG($P(RX0,"^",6),5)),"^")]"" D
.S $P(RN," ",79)=" ",IEN=IEN+1
.S ^TMP("PSOAO",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG($P(RX0,"^",6),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG($P(RX0,"^",6),5),"^") K RN
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(11) # of Refills: "_$P(RX0,"^",9)_$S($L($P(RX0,"^",9))=1:" ",1:"")_" Remaining: "_REFL
;IHS/CIA/PLS - 02/24/06 - Added code to protect from null subscript
;S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(12) Provider: "_$S($D(^VA(200,$P(RX0,"^",4),0)):$P(^VA(200,$P(RX0,"^",4),0),"^"),1:"UNKNOWN")
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(12) Provider: "_$S($D(^VA(200,+$P(RX0,"^",4),0)):$P(^VA(200,+$P(RX0,"^",4),0),"^"),1:"UNKNOWN")
I $P(RX3,"^",3) S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,$S($G(PSORX("COSIGNING PROVIDER")):PSORX("COSIGNING PROVIDER"),1:$P(RX3,"^",3)),0),"^")
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(13) Routing: "_$S($P(RX0,"^",11)="M":"MAIL",1:"WINDOW")_" (14) Copies: "_$S($P(RX0,"^",18):$P(RX0,"^",18),1:1)
S:$P(RX0,"^",11)="W"&($P(PSOPAR,"^",12)) IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Method of Pickup: "_$G(^PSRX(RXN,"MP"))
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(15) Clinic: "_$S($D(^SC(+$P(RX0,"^",5),0)):$P(^SC($P(RX0,"^",5),0),"^"),1:"Not on File")
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(16) Division: "_$S($G(^PS(59,+$P(RX2,"^",9),0))]"":$P(^PS(59,$P(RX2,"^",9),0),"^")_" ("_$P(^(0),"^",6)_")",1:"UNKNOWN")
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(17) Pharmacist: "_$S($P(RX2,"^",3):$P(^VA(200,$P(RX2,"^",3),0),"^"),1:"")
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(18) Remarks:" D RMK^PSOORNE3
; IHS/CIA/PLS - 01/15/04 - Skip Counseling for IHS
;S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(19) Counseling: "_$S($P($G(^PSRX(RXN,"PC")),"^"):"YES",1:"NO")_" "_$S($P($G(^PSRX(RXN,"PC")),"^"):"Was Counseling Understood: "_$S($P($G(^PSRX(RXN,"PC")),"^",2):"YES",1:"NO"),1:"")
S:$O(^PSRX(RXN,1,0)) REF=1,IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(20) Refill Data"
I $$STATUS^PSOBPSUT(RXN,0)'="" D
. N DAW S IEN=IEN+1,DAW=$$GETDAW^PSODAWUT(RXN,0)
. S ^TMP("PSOAO",$J,IEN,0)="(21) DAW Code: "_DAW_" - "_$$DAWEXT^PSSDAWUT(DAW)
D DISP^PSOORNE6
; IHS/CIA/PLS - 01/26/04 - Add IHS Fields to display
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="Enter a zero (0) to edit IHS specific fields."
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" NDC: "_$$GET1^DIQ(52,RXN,27)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" AWP: "_$$GET1^DIQ(52,RXN,9999999.06)_" Unit Cost: "_$$GET1^DIQ(52,RXN,17) ; IHS/CIA/PLS - 01/15/04
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Triplicate #: "_$$GET1^DIQ(52,RXN,9999999.14) ; IHS/CIA/PLS - 01/15/04
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Bill Status: "_$$GET1^DIQ(52,RXN,9999999.07)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Manufacturer: "_$$GET1^DIQ(52,RXN,28)_" Lot #: "_$$GET1^DIQ(52,RXN,24)_" ExpDate: "_$$GET1^DIQ(52,RXN,29)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Chronic Med: "_$$GET1^DIQ(52,RXN,9999999.02)
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Substitution: "_$$GET1^DIQ(52,RXN,9999999.25) ;IHS/MSC/PLS - 03/13/08
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Discharge Medication: "_$$GET1^DIQ(52,RXN,9999999.28) ;IHS/MSC/PLS - 06/04/13
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Cash Due: "_$$GET1^DIQ(52,RXN,9999999.26) ;IHS/MSC/PLS - 01/23/09
;S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Insurer: "_$$GET1^DIQ(52,RXN,9999999.12)
; End IHS Fields
S (VALMCNT,PSOPF)=IEN ;IHS/MSC/PLS - 03/21/13
I $G(PSOBEDT),PSOACT["E" S PSOACT="E"
I $G(PSOBEDT),PSOACT'["E" S PSOACT=""
Q:$G(PSORXED)!($G(COPY))!($G(UPMI)) S:$G(PSOBEDT) (PSOEDIT,PSORXED)=1 D ^PSOLMLST ; I '$G(PSOLKFL) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
K DRET,SIG
Q
UL1 ;
;I +PSOLST(ORN)=52 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) Q
;I $D(^PS(52.41,$P(PSOLST(ORN),"^",2),0)) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)_"S")
Q
PSOORNE2 ;BIR/SAB-display finished orders from backdoor ;19-May-2014 12:16;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**11,21,23,27,32,37,46,84,103,117,131,146,1004,1008,156,210,148,222,238,264,281,289,1015,1016,1017,1018**;DEC 1997;Build 21
+2 ;^PSDRUG( - 221
+3 ;^YSCL(603.01 - 2697
+4 ;^PS(50.606 - 2174
+5 ;^PS(50.7 - 2223
+6 ;PSO*210 add call to WORDWRAP api
+7 ;$$DAWEXT^PSSDAWUT - 4708
+8 ;
+9 ; Modified - IHS/CIA/PLS - 01/15/04 - Lines PTST+30
+10 ; Modified - IHS/CIA/PLS - 02/24/06 - Line PTST+23
+11 ; IHS/MSC/PLS - 03/13/08 - Line PTST+49 Substitution
+12 ; 01/23/09 - Line PTST+50 Cash Due
+13 ; 03/21/13 - Line PTST+54
+14 ; IHS/MSC/PB 08/03/12 - Line tag SIGN added at line PST+2 to pull the SIGNS and SYMPTOMS and the INDICATION CODES for display
+15 ; IHS/MSC/PLS 06/04/13 - Added Discharge Medication
+16 ; 05/19/14 - Added ACT+3
SEL NEW ORN,ORD
IF '$GET(PSOCNT)
SET VALMSG="This patient has no Prescriptions!"
SET VALMBCK=""
QUIT
+1 DO K1^PSOORNE6
SET DIR("A")="Select Orders by number"
SET DIR(0)="LO^1:"_PSOCNT
DO ^DIR
IF $DATA(DIRUT)
DO KV^PSOVER1
SET VALMBCK=""
QUIT
NEWSEL NEW ORN,ORD
DO K2^PSOORNE6
+1 IF +Y
SET PSOOELSE=1
SET PSLST=Y
KILL PSOREEDT
Begin DoDot:1
+2 FOR ORD=1:1:$LENGTH(PSLST,",")
IF $PIECE(PSLST,",",ORD)']""
QUIT
SET ORN=+$PIECE(PSLST,",",ORD)
DO @$SELECT(+PSOLST(ORN)=52:"ACT",1:"PEN^PSOORNE5")
KILL PSOREEDT,PSOSIGFL,PSONACT,SIGOK,PSOFDR,DRET,SIG,INS1
DO UL1
IF $GET(PSOQUIT)
KILL PSOQUIT
QUIT
End DoDot:1
+3 KILL PRC,PHI,RTE
IF '$GET(PSOOELSE)
SET VALMBCK=""
+4 KILL PSONACT,PSOOELSE,CLOZPAT
DO ^PSOBUILD
DO BLD^PSOORUT1
DO K3^PSOORNE6
+5 QUIT
+6 ;
ACT NEW REF
KILL ^TMP("PSOAO",$JOB),PCOMX,PDA,PHI,PRC,ACOM,ANS,PSOFDR,CLOZPAT,ANQREM,DUR,DRET
+1 SET RXN=$PIECE(PSOLST(ORN),"^",2)
SET RX0=^PSRX(RXN,0)
SET RX2=$GET(^(2))
SET RX3=$GET(^(3))
SET ST=+$GET(^("STA"))
SET RXOR=$GET(^("OR1"))
SET POE=$GET(^("POE"))
SET EXDT=$SELECT($PIECE($GET(^(2)),"^",6)>DT:1,1:0)
+2 IF 'RX3
SET RX3=$PIECE(RX2,"^",2)
SET $PIECE(^PSRX(RXN,3),"^")=$PIECE(RX2,"^",2)
+3 ;IHS/MSC/PLS - 05/19/2014
+4 IF $$GET1^DIQ(52,$GET(RXN),9999999.23,"I")
SET VALMSG="AUTOFINISHED prescriptions are not editable."
SET VALMBCK=""
QUIT
+5 SET PSODRG=+$PIECE(RX0,"^",6)
SET PSODRUG0=^PSDRUG(PSODRG,0)
SET INDT=$GET(^("I"))
+6 ;PSO*7*238;SET PSODRUG ARRAY ; PSOY KILLED AT END OF SET^PSODRG
+7 KILL PSODRUG
+8 SET PSOY=PSODRG
SET PSOY(0)=PSODRUG0
DO SET^PSODRG
+9 IF 'RXOR
IF $PIECE(^PSDRUG(PSODRG,2),"^")
SET $PIECE(^PSRX(RXN,"OR1"),"^")=$PIECE(^PSDRUG(PSODRG,2),"^")
SET RXOR=$PIECE(^PSDRUG(PSODRG,2),"^")
+10 IF $PIECE($GET(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1"
Begin DoDot:1
+11 SET CLOZPAT=$ORDER(^YSCL(603.01,"C",PSODFN,0))
IF 'CLOZPAT
QUIT
+12 ;S CLOZPAT=$S($P(^YSCL(603.01,CLOZPAT,0),"^",3)="B":1,1:0)
+13 SET CLOZPAT=$PIECE(^YSCL(603.01,CLOZPAT,0),"^",3)
+14 SET CLOZPAT=$SELECT(CLOZPAT="M":2,CLOZPAT="B":1,1:0)
End DoDot:1
+15 IF $DATA(^XUSEC("PSORPH",DUZ))
SET RPH=1
Begin DoDot:1
+16 SET PSOACT=$SELECT('ST&($GET(INDT)]"")&(DT>$GET(INDT)):"DHPLATC",ST=1:"DVE",ST=4:"DV",ST=3:"DU",ST=5:"ELTD",ST=11:"ETDPCL",ST=12&EXDT:"EDCL",ST=12&'EXDT:"ECL",(ST=14!(ST=15))&'EXDT:"ECL",ST=13:"L",ST=16:"DL",1:"DHPEATCL")
+17 DO GET^PSOORNE5
SET PSOACT=PSOACT_$SELECT(ACTREN:"N",1:"")
SET PSOACT=PSOACT_$SELECT(ACTREF:"R",1:"")
+18 IF ST=5
SET SURX=$ORDER(^PS(52.5,"B",RXN,0))
IF SURX
IF $PIECE($GET(^PS(52.5,SURX,0)),"^",7)="L"
SET PSOACT="TL"
KILL SURX
QUIT
+19 IF ST'=12&('$DATA(^PS(50.7,+$PIECE(RXOR,"^"),0)))
SET PSOACT="DL"
SET VALMSG="No Pharmacy Orderable Item !"
SET PSONACT=1
+20 IF ST=12&('$DATA(^PS(50.7,+$PIECE(RXOR,"^"),0)))
SET PSOACT="L"
SET VALMSG="No Pharmacy Orderable Item !"
SET PSONACT=1
+21 ;I ST=14!(ST=15) S VALMSG="Rx Discontinued By "_$S(ST=14:"Provider",1:"Edit")_". Cannot be Reinstated."
+22 IF ST=16
SET VALMSG="Rx Placed on HOLD by Provider."
End DoDot:1
+23 IF '$TEST
Begin DoDot:1
+24 IF ST=5
SET SURX=$ORDER(^PS(52.5,"B",RXN,0))
IF SURX
IF $PIECE($GET(^PS(52.5,SURX,0)),"^",7)="L"
SET PSOACT="TL"
QUIT
+25 SET PSOACT=$SELECT(ST'<1&(ST'>4)!(ST>12):"",ST=12&EXDT&($PIECE($GET(PSOPAR),"^",2)):"CDPLT",1:"CPLT")
+26 DO GET^PSOORNE5
SET PSOACT=PSOACT_$SELECT(ACTREN:"N",1:"")
SET PSOACT=PSOACT_$SELECT(ACTREF:"R",1:"")
+27 IF '$DATA(^PS(50.7,+$PIECE(RXOR,"^"),0))
SET PSOACT="L"
SET PSONACT=1
SET VALMSG="No Pharmacy Orderable Item !"
End DoDot:1
+28 ;K PSOLKFL D PSOL^PSSLOCK(RXN) I '$G(PSOMSG) K PSOMSG S PSOLKFL=1 S PSOACT="",VALMSG="This Order is being edited by another user."
+29 KILL PSOMSG
SET IEN=0
SET $PIECE(RN," ",12)=" "
+30 IF $GET(RPH)
IF ST=1
IF $PIECE($GET(^PSRX(RXN,"PKI")),"^")
NEW PKI,PKI1,PKIR,PKIE,DA
SET DA=RXN
DO CER^PSOPKIV1
KILL DA
IF $GET(PKI1)
DO L1^PSOPKIV1
+31 DO DIN^PSONFI(+RXOR,$PIECE(RX0,"^",6))
+32 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=$SELECT($PIECE($GET(^PSRX(RXN,"TPB")),"^"):" TPB Rx #: ",1:" Rx #: ")
+33 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_$PIECE(RX0,"^")_$SELECT($GET(^PSRX(RXN,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXN)_$EXTRACT(RN,$LENGTH($PIECE(RX0,"^")_$SELECT($GET(^PSRX(RXN,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXN))+1,12)
+34 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" ("_$SELECT($PIECE(PSOPAR,"^",3):1,1:"#")_")"_" *Orderable Item: "_$SELECT($DATA(^PS(50.7,$PIECE(+RXOR,"^"),0)):$PIECE(^PS(50.7,$PIECE(+RXOR,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^"),1:"")_NFIO
+35 IF NFIO["<DIN>"
SET NFIO=IEN_","_($LENGTH(^TMP("PSOAO",$JOB,IEN,0))-4)
+36 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" ("_$SELECT($PIECE(PSOPAR,"^",3):2,1:"#")_")"_$SELECT($DATA(^PSDRUG("AQ",$PIECE(RX0,"^",6))):" CMOP ",1:" ")_"Drug: "_$PIECE(^PSDRUG($PIECE(RX0,"^",6),0),"^")_NFID
+37 IF NFID["<DIN>"
SET NFID=IEN_","_($LENGTH(^TMP("PSOAO",$JOB,IEN,0))-4)
+38 IF $$STATUS^PSOBPSUT(RXN,0)'=""
IF $$RXRLDT^PSOBPSUT(RXN,0)
Begin DoDot:1
+39 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" "_$SELECT('$PIECE(PSOPAR,"^",3):"(2)",1:" ")_" NDC: "_$$GETNDC^PSONDCUT(RXN,0)
End DoDot:1
+40 IF $GET(^PSRX(RXN,"TN"))]""
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Trade Name: "_$GET(^PSRX(RXN,"TN"))
+41 DO DOSE^PSOORNE5
+42 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" (4)Pat Instructions:"
DO INS^PSOORNE5
+43 DO PC^PSOORNE5
+44 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" SIG:"
+45 IF '$PIECE($GET(^PSRX(RXN,"SIG")),"^",2)
SET SIGOK=0
Begin DoDot:1
+46 SET X=$PIECE($GET(^PSRX(RXN,"SIG")),"^")
DO SIGONE^PSOHELP
SET SIG=$EXTRACT($GET(INS1),2,250)
+47 FOR SG=1:1:$LENGTH(SIG)
IF $LENGTH(^TMP("PSOAO",$JOB,IEN,0)_" "_$PIECE(SIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAO",$JOB,IEN,0)," ",21)=" "
IF $PIECE(SIG," ",SG)'=""
SET ^TMP("PSOAO",$JOB,IEN,0)=$GET(^TMP("PSOAO",$JOB,IEN,0))_" "_$PIECE(SIG," ",SG)
End DoDot:1
GOTO PTST
+48 SET SIGOK=1
+49 ;PSO*210
FOR I=0:0
SET I=$ORDER(^PSRX(RXN,"SIG1",I))
IF 'I
QUIT
Begin DoDot:1
+50 SET MIG=$PIECE(^PSRX(RXN,"SIG1",I,0),"^")
+51 DO WORDWRAP^PSOUTLA2(MIG,.IEN,$NAME(^TMP("PSOAO",$JOB)),21)
End DoDot:1
+52 SET SIGOK=1
KILL MIG,SG
PTST ;
+1 ;IHS/MSC/PB - 08/03/12 Next line added to pull the SIGNS and SYMPTOMS and the INDICATION CODE for display
+2 ;IEN=IEN+1
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Clinical Indication: "_$PIECE($GET(^PSRX(RXN,999999921)),"^",1)_" "_$PIECE($GET(^PSRX(RXN,999999921)),"^",2)
+3 SET $PIECE(RN," ",25)=" "
SET PTST=$SELECT($GET(^PS(53,+$PIECE(RX0,"^",3),0))]"":$PIECE($GET(^PS(53,+$PIECE(RX0,"^",3),0)),"^"),1:"")
SET IEN=IEN+1
+4 SET ^TMP("PSOAO",$JOB,IEN,0)=" (5) Patient Status: "_PTST_$EXTRACT(RN,$LENGTH(PTST)+1,25)
+5 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" (6) Issue Date: "_$EXTRACT($PIECE(RX0,"^",13),4,5)_"/"_$EXTRACT($PIECE(RX0,"^",13),6,7)_"/"_$EXTRACT($PIECE(RX0,"^",13),2,3)
+6 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_" (7) Fill Date: "_$EXTRACT($PIECE(RX2,"^",2),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",2),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",2),2,3)
+7 SET ROU=$SELECT($PIECE(RX0,"^",11)="W":"Window",1:"Mail")
+8 SET REFL=$PIECE(RX0,"^",9)
SET I=0
FOR
SET I=$ORDER(^PSRX(RXN,1,I))
IF 'I
QUIT
SET REFL=REFL-1
SET ROU=$SELECT($PIECE(^PSRX(RXN,1,I,0),"^",2)="W":"Window",1:"Mail")
+9 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Last Fill Date: "_$EXTRACT($PIECE(RX3,"^"),4,5)_"/"_$EXTRACT($PIECE(RX3,"^"),6,7)_"/"_$EXTRACT($PIECE(RX3,"^"),2,3)
+10 DO CMOP^PSOORNE3
+11 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_" ("_ROU_$SELECT($GET(PSOCMOP)]"":", "_PSOCMOP,1:"")_")"
KILL ROU,PSOCMOP
+12 SET IEN=IEN+1
IF $PIECE(RX2,"^",15)
SET ^TMP("PSOAO",$JOB,IEN,0)=" Returned to Stock: "_$EXTRACT($PIECE(RX2,"^",15),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",15),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",15),2,3)_$SELECT($PIECE(RX2,"^",14):" (Reprinted)",1:"")
+13 IF '$TEST
SET ^TMP("PSOAO",$JOB,IEN,0)=" Last Release Date: "
Begin DoDot:1
+14 SET RLD=$SELECT($PIECE(RX2,"^",13):$EXTRACT($PIECE(RX2,"^",13),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",13),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",13),2,3),1:"")
+15 IF $ORDER(^PSRX(RXN,1,0))
FOR I=0:0
SET I=$ORDER(^PSRX(RXN,1,I))
IF 'I
QUIT
Begin DoDot:2
+16 IF $PIECE(^PSRX(RXN,1,I,0),"^",18)
SET RLD=$EXTRACT($PIECE(^(0),"^",18),4,5)_"/"_$EXTRACT($PIECE(^(0),"^",18),6,7)_"/"_$EXTRACT($PIECE(^(0),"^",18),2,3)
End DoDot:2
+17 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_$SELECT($GET(RLD)]"":RLD,1:" ")
End DoDot:1
+18 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_" (8) Lot #: "_$PIECE($GET(RX2),"^",4)
+19 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Expires: "_$EXTRACT($PIECE(RX2,"^",6),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",6),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",6),2,3)
+20 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_" MFG: "_$PIECE($GET(RX2),"^",8)
+21 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(9) Days Supply: "_$PIECE(RX0,"^",8)_$SELECT($LENGTH($PIECE(RX0,"^",8))=1:" ",1:"")
+22 SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_" (10) QTY"_$SELECT($PIECE($GET(^PSDRUG($PIECE(RX0,"^",6),660)),"^",8)]"":" ("_$PIECE($GET(^PSDRUG($PIECE(RX0,"^",6),660)),"^",8)_")",1:" ( )")_": "_$PIECE(RX0,"^",7)
+23 IF $PIECE($GET(^PSDRUG($PIECE(RX0,"^",6),5)),"^")]""
Begin DoDot:1
+24 SET $PIECE(RN," ",79)=" "
SET IEN=IEN+1
+25 SET ^TMP("PSOAO",$JOB,IEN,0)=$EXTRACT(RN,$LENGTH("QTY DSP MSG: "_$PIECE(^PSDRUG($PIECE(RX0,"^",6),5),"^"))+1,79)_"QTY DSP MSG: "_$PIECE(^PSDRUG($PIECE(RX0,"^",6),5),"^")
KILL RN
End DoDot:1
+26 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(11) # of Refills: "_$PIECE(RX0,"^",9)_$SELECT($LENGTH($PIECE(RX0,"^",9))=1:" ",1:"")_" Remaining: "_REFL
+27 ;IHS/CIA/PLS - 02/24/06 - Added code to protect from null subscript
+28 ;S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(12) Provider: "_$S($D(^VA(200,$P(RX0,"^",4),0)):$P(^VA(200,$P(RX0,"^",4),0),"^"),1:"UNKNOWN")
+29 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(12) Provider: "_$SELECT($DATA(^VA(200,+$PIECE(RX0,"^",4),0)):$PIECE(^VA(200,+$PIECE(RX0,"^",4),0),"^"),1:"UNKNOWN")
+30 IF $PIECE(RX3,"^",3)
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Cos-Provider: "_$PIECE(^VA(200,$SELECT($GET(PSORX("COSIGNING PROVIDER")):PSORX("COSIGNING PROVIDER"),1:$PIECE(RX3,"^",3)),0),"^")
+31 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(13) Routing: "_$SELECT($PIECE(RX0,"^",11)="M":"MAIL",1:"WINDOW")_" (14) Copies: "_$SELECT($PIECE(RX0,"^",18):$PIECE(RX0,"^",18),1:1)
+32 IF $PIECE(RX0,"^",11)="W"&($PIECE(PSOPAR,"^",12))
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Method of Pickup: "_$GET(^PSRX(RXN,"MP"))
+33 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(15) Clinic: "_$SELECT($DATA(^SC(+$PIECE(RX0,"^",5),0)):$PIECE(^SC($PIECE(RX0,"^",5),0),"^"),1:"Not on File")
+34 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(16) Division: "_$SELECT($GET(^PS(59,+$PIECE(RX2,"^",9),0))]"":$PIECE(^PS(59,$PIECE(RX2,"^",9),0),"^")_" ("_$PIECE(^(0),"^",6)_")",1:"UNKNOWN")
+35 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(17) Pharmacist: "_$SELECT($PIECE(RX2,"^",3):$PIECE(^VA(200,$PIECE(RX2,"^",3),0),"^"),1:"")
+36 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(18) Remarks:"
DO RMK^PSOORNE3
+37 ; IHS/CIA/PLS - 01/15/04 - Skip Counseling for IHS
+38 ;S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)="(19) Counseling: "_$S($P($G(^PSRX(RXN,"PC")),"^"):"YES",1:"NO")_" "_$S($P($G(^PSRX(RXN,"PC")),"^"):"Was Counseling Understood: "_$S($P($G(^PSRX(RXN,"PC")),"^",2):"YES",1:"NO"),1:"")
+39 IF $ORDER(^PSRX(RXN,1,0))
SET REF=1
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="(20) Refill Data"
+40 IF $$STATUS^PSOBPSUT(RXN,0)'=""
Begin DoDot:1
+41 NEW DAW
SET IEN=IEN+1
SET DAW=$$GETDAW^PSODAWUT(RXN,0)
+42 SET ^TMP("PSOAO",$JOB,IEN,0)="(21) DAW Code: "_DAW_" - "_$$DAWEXT^PSSDAWUT(DAW)
End DoDot:1
+43 DO DISP^PSOORNE6
+44 ; IHS/CIA/PLS - 01/26/04 - Add IHS Fields to display
+45 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)="Enter a zero (0) to edit IHS specific fields."
+46 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" NDC: "_$$GET1^DIQ(52,RXN,27)
+47 ; IHS/CIA/PLS - 01/15/04
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" AWP: "_$$GET1^DIQ(52,RXN,9999999.06)_" Unit Cost: "_$$GET1^DIQ(52,RXN,17)
+48 ; IHS/CIA/PLS - 01/15/04
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Triplicate #: "_$$GET1^DIQ(52,RXN,9999999.14)
+49 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Bill Status: "_$$GET1^DIQ(52,RXN,9999999.07)
+50 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Manufacturer: "_$$GET1^DIQ(52,RXN,28)_" Lot #: "_$$GET1^DIQ(52,RXN,24)_" ExpDate: "_$$GET1^DIQ(52,RXN,29)
+51 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Chronic Med: "_$$GET1^DIQ(52,RXN,9999999.02)
+52 ;IHS/MSC/PLS - 03/13/08
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Substitution: "_$$GET1^DIQ(52,RXN,9999999.25)
+53 ;IHS/MSC/PLS - 06/04/13
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Discharge Medication: "_$$GET1^DIQ(52,RXN,9999999.28)
+54 ;IHS/MSC/PLS - 01/23/09
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Cash Due: "_$$GET1^DIQ(52,RXN,9999999.26)
+55 ;S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Insurer: "_$$GET1^DIQ(52,RXN,9999999.12)
+56 ; End IHS Fields
+57 ;IHS/MSC/PLS - 03/21/13
SET (VALMCNT,PSOPF)=IEN
+58 IF $GET(PSOBEDT)
IF PSOACT["E"
SET PSOACT="E"
+59 IF $GET(PSOBEDT)
IF PSOACT'["E"
SET PSOACT=""
+60 ; I '$G(PSOLKFL) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
IF $GET(PSORXED)!($GET(COPY))!($GET(UPMI))
QUIT
IF $GET(PSOBEDT)
SET (PSOEDIT,PSORXED)=1
DO ^PSOLMLST
+61 KILL DRET,SIG
+62 QUIT
UL1 ;
+1 ;I +PSOLST(ORN)=52 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) Q
+2 ;I $D(^PS(52.41,$P(PSOLST(ORN),"^",2),0)) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)_"S")
+3 QUIT
