PSOORNE2.m

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