PSOORNEW.m

PSOORNEW ;BIR/SAB-display orders from oerr ;04-Jun-2013 12:54;DU

 ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,55,46,71,90,94,106,131,133,1005,1008,1013,143,237,222,258,206,225,1015,1017**;DEC 1997;Build 40

 ;^PS(50.7 -2223

 ;^PSDRUG -221

 ;^PS(50.606 -2174

 ;^PS(55 -2228

 ;EN1^ORCFLAG -3620

 ;

 ;PSO*237 quit Finish if Today > Issue date + 365

 ; Modified - IHS/CIA/PLS - 01/26/04 - Lines EDTSEL+1, PT+34, and new 0 EP

 ;            IHS/MSC/PLS - 03/13/08 - Line PT+42 Substitution

 ;                          01/23/09 - Line PT+43 Cash Due

 ;                          10/31/11 - Line ACP+17

 ;                          06/04/13 - Added Discharge Medication

DSPL I $G(PSODSPL) S VALMBCK="Q" K PSODSPL,PSOANSQD Q

 Q:'$D(PSOLMC)  K ^TMP("PSOPO",$J) S PSOLMC=PSOLMC+1

 I $D(CLOZPAT) S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),1:7) G OI

 S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3))&('$G(PSONEW("DAYS SUPPLY"))):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30)

OI I '$G(PSODRUG("OI")) D

 .S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9)

 .I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR

 I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A",$G(PSODRUG("DEA"))'["B"!($G(PSODRUG("DEA"))["F")!($G(PSODRUG("DEA"))[1)!($G(PSODRUG("DEA"))[2) S PSONEW("# OF REFILLS")=0

 I $D(CLOZPAT) S PSONEW("# OF REFILLS")=$S($D(PSONEW("# OF REFILLS")):PSONEW("# OF REFILLS"),$G(CLOZPAT)=2&($P(OR0,"^",11)>2):3,$G(CLOZPAT)&($P(OR0,"^",11)>1):1,1:0)

 S IEN=0 D OBX^PSOORFI1,LMDISP^PSOORFI5(ORD),DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:""))

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="*(1) Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO

 S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)

 K LST I $G(PSODRUG("NAME"))]"" D  G PT

 .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):"      CMOP ",1:"           ")_"Drug: "_PSODRUG("NAME")_NFID

 .S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)

 .I $P($G(^PSDRUG(PSODRUG("IEN"),0)),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       Drug Message:" D DRGMSG

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)           Drug: No Dispense Drug Selected"

PT D DOSE2^PSOORFI4

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4)   Pat Instruct:" D:$O(PSONEW("SIG",0)) INST^PSOORFI4

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="  Provider Comments:" S TY=3 D INST^PSOORFI1

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       Instructions:" S TY=2 D INST^PSOORFI1

 K PSOELSE S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="                SIG:"

 F I=0:0 S I=$O(SIG(I)) Q:'I  S SIG=SIG(I) D

 .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG)

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^")

 K PSOELSE I $G(PSONEW("ISSUE DATE"))']"" S PSOELSE=1 S IEN=IEN+1,(PSOID,Y)=$E($P(OR0,"^",6),1,7) X ^DD("DD") S PSONEW("ISSUE DATE")=Y,^TMP("PSOPO",$J,IEN,0)=" (4)     Issue Date: "_Y

 I '$G(PSOELSE) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6)     Issue Date: "_PSONEW("ISSUE DATE")

 K PSOELSE I $G(PSORX("FILL DATE"))']"" S PSOELSE=1 D

 .S (Y,PSORX("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)<DT:DT,1:$E($P(OR0,"^",6),1,7)) X ^DD("DD") S PSONEW("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"                  (5) Fill Date: "_Y

 I '$G(PSOELSE) S Y=PSORX("FILL DATE") X ^DD("DD") S PSORX("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"       (7) Fill Date: "_PSORX("FILL DATE")

 I $P(OR0,"^",18) S IEN=IEN+1,Y=$P(OR0,"^",18) X ^DD("DD") S $P(^TMP("PSOPO",$J,IEN,0)," ",39)="Effective Date: "_Y

 I $D(CLOZPAT) D ELIG^PSOORFI2 S:'$D(PSONEW("QTY")) PSONEW("QTY")=0

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8)    Days Supply: "_PSONEW("DAYS SUPPLY")

 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"               (9)   QTY"_$S($P($G(^PSDRUG(+$G(PSODRUG("IEN")),660)),"^",8)]"":" ("_$P($G(^PSDRUG(+PSODRUG("IEN"),660)),"^",8)_")",1:" (  )")

 S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_": "_$S($G(PSONEW("QTY"))]"":PSONEW("QTY"),1:$P(OR0,"^",10))

 I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D

 .S $P(RN," ",79)=" ",IEN=IEN+1

 .S ^TMP("PSOPO",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^") K RN

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       Provider ordered "_+$P(OR0,"^",11)_" refills"

 D:$D(CLOZPAT) PQTY^PSOORFI4

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(10)   # of Refills: "_$S($G(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),1:$P(OR0,"^",11))_"               (11)   Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW")

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(12)         Clinic: "_PSORX("CLINIC")

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(13)       Provider: "_PSONEW("PROVIDER NAME")

 I $P($G(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS")),"^",7)&($P($G(^("PS")),"^",8)) D

 .S IEN=IEN+1,PSONEW("COSIGNING PROVIDER")=$S($G(PSONEW("COSIGNING PROVIDER")):PSONEW("COSIGNING PROVIDER"),1:$P(^("PS"),"^",8))

 .S ^TMP("PSOPO",$J,IEN,0)="       Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(14)         Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1)

 S PSONEW("REMARKS")=$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),$P(OR0,"^",17)="C":"Administered in Clinic.",1:"")

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15)        Remarks:"

 I $G(PSONEW("REMARKS"))]"" D

 .F SG=1:1:$L(PSONEW("REMARKS")) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(PSONEW("REMARKS")," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D

 ..S:$P(PSONEW("REMARKS")," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("REMARKS")," ",SG)

 ; IHS/CIA/PLS - 01/26/04 - Add IHS Fields to display

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="Enter a zero (0) to edit IHS specific fields."

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="                NDC: "_$G(PSONEW("NDC"))

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="                AWP: "_$G(PSONEW("AWP"))_"       Unit Cost: "_$G(PSONEW("COST"))   ; IHS/CIA/PLS - 01/15/04

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       Triplicate #: "_$G(PSONEW("TRIP"))   ; IHS/CIA/PLS - 01/15/04

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="        Bill Status: "_$$EXTERNAL^DILFD(52,9999999.07,,$G(PSONEW("BST")))

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       Manufacturer: "_$G(PSONEW("MANUFACTURER"))_"   Lot #: "_$G(PSONEW("LOT #"))_"  ExpDate: "_$$FMTE^XLFDT($G(PSONEW("EXPIRATION DATE")))

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="        Chronic Med: "_$$EXTERNAL^DILFD(52,9999999.02,,$G(PSONEW("CM")))

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="       Substitution: "_$$EXTERNAL^DILFD(52,9999999.25,,$G(PSONEW("DAW")))  ;IHS/MSC/PLS - 03/13/08

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="Discharge Medication: "_$$EXTERNAL^DILFD(52,9999999.28,,$G(PSONEW("DSCMED")))   ;IHS/MSC/PLS - 06/04/13

 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="           Cash Due: "_$$EXTERNAL^DILFD(52,9999999.26,,$G(PSONEW("CASH DUE")))  ;IHS/MSC/PLS - 01/23/09

 ;S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="            Insurer: "_$G(PSONEW("INSURER"))

 ; End IHS Fields

 I $G(PSOSIGFL)!(PSODRUG("OI")'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSORX("CLERK CODE")=$P(^VA(200,DUZ,0),"^"),VALMSG="This change will create a new prescription!"

 S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="   Entry By: "_$P(^VA(200,PSONEW("CLERK CODE"),0),"^")_$E(RN,$L($P(^VA(200,PSONEW("CLERK CODE"),0),"^"))+1,35)

 S Y=$P(OR0,"^",12) X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$E($P(OR0,"^",12),4,5)_"/"_$E($P(OR0,"^",12),6,7)_"/"_$E($P(OR0,"^",12),2,3)_" "_$P(Y,"@",2) K RN

 I PSOLMC<2 D ^PSOLMPO1 S VALMBCK="Q",PSOLMC=0

 S:PSOLMC>1 VALMBCK="R"

 Q

ORCHK D PROVCOM^PSOORFI4,ORCHK^PSOORFI4

 Q

 ; IHS/CIA/PLS - 01/26/04 - Allow zero in range

EDT ;D KV S DIR("A",1)="* Indicates which fields will create an new Order",DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:15" D ^DIR Q:$D(DTOUT)!($D(DUOUT))

 D KV S DIR("A",1)="* Indicates which fields will create an new Order",DIR("A")="Select Field to Edit by number",DIR(0)="LO^0:15" D ^DIR Q:$D(DTOUT)!($D(DUOUT))

EDTSEL N LST,FLD,OUT D KV S OUT=0

 ; IHS/CIA/PLS - 01/26/04 - Allow zero

 ;I +Y S LST=Y D FULL^VALM1 N PSODOSE M PSODOSE=PSONEW D  G DSPL

 I $L(Y) S LST=Y D FULL^VALM1 N PSODOSE M PSODOSE=PSONEW D  G DSPL

 .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']""!(OUT)  D @(+$P(LST,",",FLD)) D:$P(LST,",",FLD)=8 REF D KV

 E  S VALMBCK="" Q

 Q

ACP ;

 I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D  Q:$D(DIRUT)!'Y  D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1

 . D FULL^VALM1 D KV

 . S DIR("A",1)="This Order is flagged. In order to finish it"

 . S DIR("A",2)="you must unflag it first."

 . S DIR("A",3)=""

 . S DIR(0)="Y",DIR("A")="Unflag Order",DIR("B")="NO"

 . W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q"

 I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q

 ;

 I $D(CLOZPAT),+$G(PSONEW("QTY"))=0 S VALMSG="Unable to calculate the quantity, enter a quantity" G DSPL

 S (PSODIR("DFLG"),PSORX("DFLG"),PSODIR("QFLD"))=0,ACP=1 D ORCHK

 G:$G(PSONEW("QFLG")) DSPL

 I $G(PSODIR("DFLG"))!$G(PSORX("DFLG")) Q

 I $G(PSONEW("FLD"))!($G(PSODRUG("NAME"))']"")!('$O(SIG(0))) G DSPL

 I $G(PSODRUG("NAME"))]"",'$G(ORCHK)!($G(ORDRG)'=PSODRUG("NAME")) D  I $G(PSORX("DFLG")) D CLEAN^PSOVER1 G DSPL

 .D POST^PSODRG S:'$G(PSORX("DFLG")) ORCHK=1,ORDRG=PSODRUG("NAME")

 I '$D(PSONEW("RX #")) S PSOFROM="NEW",RTN=$S($P($G(PSOPAR),"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN") D @RTN Q:PSONEW("QFLG")  I '$P($G(PSOPAR),"^",7) S PSOX=PSONEW("RX #") D CHECK^PSONRXN

 D RXNCHK^PSOORNE1 I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 Q

 I DT>$$FMADD^XLFDT($P(OR0,"^",6),365) D EXPR^PSONEW2 G DSPL

 D STOP^PSONEW2,DISPLAY^PSONEW2,^PSONEWF

 I $G(PSOCPZ("DFLG")) W !!,"No action taken!",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR,KV K PSOCPZ("DFLG"),DRET,PSOANSQD S VALMBCK="Q" Q

 ;

 K PSOCPZ("DFLG") D KV S DIR(0)="Y",DIR("A")="Are you sure you want to Accept this Order",DIR("B")="NO" D ^DIR I $D(DIRUT) D KV K DRET,PSOANSQ,PSOANSQD S VALMBCK="Q" Q

 D KV I 'Y K PSOANSQ G DSPL

 I $G(PSONEW("MAIL/WINDOW"))["W" D:$P($G(PSOPAR),"^",12)  S BINGCRT="Y",BINGRTE="W",PSORX("MAIL/WINDOW")="WINDOW" K RTN

 .W ! K DIR,DIRUT S DIR(0)="52,35O"

 .S:$G(PSORX("METHOD OF PICK-UP"))]"" DIR("B")=PSORX("METHOD OF PICK-UP") D ^DIR I $D(DIRUT) K DIR,DIRUT Q

 .S (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y K X,Y

 S PSONEW("POE")=1 D EN^PSON52(.PSONEW) G:$G(PSONEW("DFLG")) ABORT D DCORD^PSONEW2

 D EN^APSPPCC1(PSODFN,PSONEW("IRXN"))

 D DCORD^PSONEW2

 D NPSOSD^PSOUTIL(.PSONEW),FULL^VALM1 K PSORX("MAIL/WINDOW")

 D EOJ^PSONEW

ABORT S VALMBCK="Q",DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR,CLEAN^PSOVER1,KV

 Q

KV K DIRUT,DUOUT,DTOUT,DIR

 Q

REF D REF^PSOORFI4

 Q

0 ; EP - IHS/CIA/PLS - 01/26/04 - Prompt IHS Fields

 D IHSFLDS^APSPDIR(.PSONEW) Q

 ;

1 N PSOBDR,PSOBDRG S PSOBDRG=1 D 1^PSOORNW2 Q  ;oi

 ;

4 D INS^PSOORNW2 Q

 ;

3 D DOSE^PSOORED4(.PSONEW) Q

 ;

6 D 4^PSOORNW2 Q  ;idt

 ;

7 D 5^PSOORNW2 Q  ;fdt

 ;

5 D 3^PSOORNW2 Q  ;pstat

 ;

13 D 12^PSOORNW2 Q  ;doc

 ;

12 D 11^PSOORNW2 Q  ;cli

 ;

2 N PSOCSIG I '$G(PSOBDRG) N PSOBDR,PSOBDRG S PSOBDRG=1

 D 2^PSOORNW1 Q:$G(PSOQFLG)  D EN^PSODIAG  ;drg/ICD

 I $G(PSOCSIG) K PSOCSIG G 3

 Q

 ;

9 D 8^PSOORNW2 Q  ;qty

 ;

8 D 7^PSOORNW2 Q  ;ds

 ;

10 D 9^PSOORNW2 Q  ;#rfs

 ;

14 D 13^PSOORNW2 Q  ;cop

 ;

11 D 10^PSOORNW2 Q  ;m/w

 ;

15 D 14^PSOORNW2 Q  ;rem

 ;

DRGMSG ;

 F SG=1:1:$L($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D

 .S:$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)

 K SG Q

PSOORNEW  ;BIR/SAB-display orders from oerr ;04-Jun-2013 12:54;DU

 +1       ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,55,46,71,90,94,106,131,133,1005,1008,1013,143,237,222,258,206,225,1015,1017**;DEC 1997;Build 40

 +2       ;^PS(50.7 -2223

 +3       ;^PSDRUG -221

 +4       ;^PS(50.606 -2174

 +5       ;^PS(55 -2228

 +6       ;EN1^ORCFLAG -3620

 +7       ;

 +8       ;PSO*237 quit Finish if Today > Issue date + 365

 +9       ; Modified - IHS/CIA/PLS - 01/26/04 - Lines EDTSEL+1, PT+34, and new 0 EP

 +10      ;            IHS/MSC/PLS - 03/13/08 - Line PT+42 Substitution

 +11      ;                          01/23/09 - Line PT+43 Cash Due

 +12      ;                          10/31/11 - Line ACP+17

 +13      ;                          06/04/13 - Added Discharge Medication

DSPL       IF $GET(PSODSPL)

               SET VALMBCK="Q"

               KILL PSODSPL,PSOANSQD

               QUIT 

 +1        IF '$DATA(PSOLMC)

               QUIT 

           KILL ^TMP("PSOPO",$JOB)

           SET PSOLMC=PSOLMC+1

 +2        IF $DATA(CLOZPAT)

               SET PSONEW("DAYS SUPPLY")=$SELECT($GET(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),1:7)

               GOTO OI

 +3        SET PSONEW("DAYS SUPPLY")=$SELECT($GET(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$GET(^PS(55,PSODFN,"PS"))&($PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3))&('$GET(PSONEW("DAYS SUPPLY"))):$PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3

),1:30)

OI         IF '$GET(PSODRUG("OI"))

               Begin DoDot:1

 +1                SET (OI,PSODRUG("OI"))=$PIECE(OR0,"^",8)

                   SET PSODRUG("OIN")=$PIECE(^PS(50.7,$PIECE(OR0,"^",8),0),"^")

                   SET OID=$PIECE(OR0,"^",9)

 +2                IF $PIECE($GET(OR0),"^",9)

                       SET POERR=1

                       SET DREN=$PIECE(OR0,"^",9)

                       DO DRG^PSOORDRG

                       KILL POERR

               End DoDot:1

 +3        IF '$DATA(CLOZPAT)

               IF $GET(PSODRUG("DEA"))["A"

                   IF $GET(PSODRUG("DEA"))'["B"!($GET(PSODRUG("DEA"))["F")!($GET(PSODRUG("DEA"))[1)!($GET(PSODRUG("DEA"))[2)

                       SET PSONEW("# OF REFILLS")=0

 +4        IF $DATA(CLOZPAT)

               SET PSONEW("# OF REFILLS")=$SELECT($DATA(PSONEW("# OF REFILLS")):PSONEW("# OF REFILLS"),$GET(CLOZPAT)=2&($PIECE(OR0,"^",11)>2):3,$GET(CLOZPAT)&($PIECE(OR0,"^",11)>1):1,1:0)

 +5        SET IEN=0

           DO OBX^PSOORFI1

           DO LMDISP^PSOORFI5(ORD)

           DO DIN^PSONFI(PSODRUG("OI"),$SELECT($GET(PSODRUG("IEN")):PSODRUG("IEN"),1:""))

 +6        SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="*(1) Orderable Item: "_$PIECE(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_NFIO

 +7        IF NFIO["<DIN>"

               SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)

 +8        KILL LST

           IF $GET(PSODRUG("NAME"))]""

               Begin DoDot:1

 +9                SET IEN=IEN+1

                   SET ^TMP("PSOPO",$JOB,IEN,0)=" (2)"_$SELECT($DATA(^PSDRUG("AQ",PSODRUG("IEN"))):"      CMOP ",1:"           ")_"Drug: "_PSODRUG("NAME")_NFID

 +10               IF NFID["<DIN>"

                       SET NFID=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)

 +11               IF $PIECE($GET(^PSDRUG(PSODRUG("IEN"),0)),"^",10)]""

                       SET IEN=IEN+1

                       SET ^TMP("PSOPO",$JOB,IEN,0)="       Drug Message:"

                       DO DRGMSG

               End DoDot:1

               GOTO PT

 +12       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)=" (2)           Drug: No Dispense Drug Selected"

PT         DO DOSE2^PSOORFI4

 +1        SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)=" (4)   Pat Instruct:"

           IF $ORDER(PSONEW("SIG",0))

               DO INST^PSOORFI4

 +2        SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="  Provider Comments:"

           SET TY=3

           DO INST^PSOORFI1

 +3        SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="       Instructions:"

           SET TY=2

           DO INST^PSOORFI1

 +4        KILL PSOELSE

           SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="                SIG:"

 +5        FOR I=0:0

               SET I=$ORDER(SIG(I))

               IF 'I

                   QUIT 

               SET SIG=SIG(I)

               Begin DoDot:1

 +6                FOR SG=1:1:$LENGTH(SIG)

                       IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG," ",SG))>80

                           SET IEN=IEN+1

                           SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "

                       IF $PIECE(SIG," ",SG)'=""

                           SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG," ",SG)

               End DoDot:1

 +7        SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)=" (5) Patient Status: "_$PIECE($GET(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^")

 +8        KILL PSOELSE

           IF $GET(PSONEW("ISSUE DATE"))']""

               SET PSOELSE=1

               SET IEN=IEN+1

               SET (PSOID,Y)=$EXTRACT($PIECE(OR0,"^",6),1,7)

               XECUTE ^DD("DD")

               SET PSONEW("ISSUE DATE")=Y

               SET ^TMP("PSOPO",$JOB,IEN,0)=" (4)     Issue Date: "_Y

 +9        IF '$GET(PSOELSE)

               SET IEN=IEN+1

               SET ^TMP("PSOPO",$JOB,IEN,0)=" (6)     Issue Date: "_PSONEW("ISSUE DATE")

 +10       KILL PSOELSE

           IF $GET(PSORX("FILL DATE"))']""

               SET PSOELSE=1

               Begin DoDot:1

 +11               SET (Y,PSORX("FILL DATE"))=$SELECT($EXTRACT($PIECE(OR0,"^",6),1,7)<DT:DT,1:$EXTRACT($PIECE(OR0,"^",6),1,7))

                   XECUTE ^DD("DD")

                   SET PSONEW("FILL DATE")=Y

                   SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"                  (5) Fill Date: "_Y

               End DoDot:1

 +12       IF '$GET(PSOELSE)

               SET Y=PSORX("FILL DATE")

               XECUTE ^DD("DD")

               SET PSORX("FILL DATE")=Y

               SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"       (7) Fill Date: "_PSORX("FILL DATE")

 +13       IF $PIECE(OR0,"^",18)

               SET IEN=IEN+1

               SET Y=$PIECE(OR0,"^",18)

               XECUTE ^DD("DD")

               SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",39)="Effective Date: "_Y

 +14       IF $DATA(CLOZPAT)

               DO ELIG^PSOORFI2

               IF '$DATA(PSONEW("QTY"))

                   SET PSONEW("QTY")=0

 +15       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)=" (8)    Days Supply: "_PSONEW("DAYS SUPPLY")

 +16       SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"               (9)   QTY"_$SELECT($PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),660)),"^",8)]"":" ("_$PIECE($GET(^PSDRUG(+PSODRUG("IEN"),660)),"^",8)_")",1:" (  )")

 +17       SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_": "_$SELECT($GET(PSONEW("QTY"))]"":PSONEW("QTY"),1:$PIECE(OR0,"^",10))

 +18       IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),5)),"^")]""

               Begin DoDot:1

 +19               SET $PIECE(RN," ",79)=" "

                   SET IEN=IEN+1

 +20               SET ^TMP("PSOPO",$JOB,IEN,0)=$EXTRACT(RN,$LENGTH("QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^")

                   KILL RN

               End DoDot:1

 +21       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="       Provider ordered "_+$PIECE(OR0,"^",11)_" refills"

 +22       IF $DATA(CLOZPAT)

               DO PQTY^PSOORFI4

 +23       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="(10)   # of Refills: "_$SELECT($GET(PSONEW("# OF REFILLS"))]"":PSONEW("# OF REFILLS"),1:$PIECE(OR0,"^",11))_"               (11)   Routing: "_$SELECT($GET(PSONEW("MAIL/WINDOW"))="M":"MAIL",1:"WINDOW")

 +24       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="(12)         Clinic: "_PSORX("CLINIC")

 +25       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="(13)       Provider: "_PSONEW("PROVIDER NAME")

 +26       IF $PIECE($GET(^VA(200,$SELECT($GET(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$PIECE(OR0,"^",5)),"PS")),"^",7)&($PIECE($GET(^("PS")),"^",8))

               Begin DoDot:1

 +27               SET IEN=IEN+1

                   SET PSONEW("COSIGNING PROVIDER")=$SELECT($GET(PSONEW("COSIGNING PROVIDER")):PSONEW("COSIGNING PROVIDER"),1:$PIECE(^("PS"),"^",8))

 +28               SET ^TMP("PSOPO",$JOB,IEN,0)="       Cos-Provider: "_$PIECE(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")

               End DoDot:1

 +29       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="(14)         Copies: "_$SELECT($GET(PSONEW("COPIES")):PSONEW("COPIES"),1:1)

 +30       SET PSONEW("REMARKS")=$SELECT($GET(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),$PIECE(OR0,"^",17)="C":"Administered in Clinic.",1:"")

 +31       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="(15)        Remarks:"

 +32       IF $GET(PSONEW("REMARKS"))]""

               Begin DoDot:1

 +33               FOR SG=1:1:$LENGTH(PSONEW("REMARKS"))

                       IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(PSONEW("REMARKS")," ",SG))>80

                           SET IEN=IEN+1

                           SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "

                       Begin DoDot:2

 +34                       IF $PIECE(PSONEW("REMARKS")," ",SG)'=""

                               SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(PSONEW("REMARKS")," ",SG)

                       End DoDot:2

               End DoDot:1

 +35      ; IHS/CIA/PLS - 01/26/04 - Add IHS Fields to display

 +36       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="Enter a zero (0) to edit IHS specific fields."

 +37       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="                NDC: "_$GET(PSONEW("NDC"))

 +38      ; IHS/CIA/PLS - 01/15/04

           SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="                AWP: "_$GET(PSONEW("AWP"))_"       Unit Cost: "_$GET(PSONEW("COST"))

 +39      ; IHS/CIA/PLS - 01/15/04

           SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="       Triplicate #: "_$GET(PSONEW("TRIP"))

 +40       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="        Bill Status: "_$$EXTERNAL^DILFD(52,9999999.07,,$GET(PSONEW("BST")))

 +41       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="       Manufacturer: "_$GET(PSONEW("MANUFACTURER"))_"   Lot #: "_$GET(PSONEW("LOT #"))_"  ExpDate: "_$$FMTE^XLFDT($GET(PSONEW("EXPIRATION DATE")))

 +42       SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="        Chronic Med: "_$$EXTERNAL^DILFD(52,9999999.02,,$GET(PSONEW("CM")))

 +43      ;IHS/MSC/PLS - 03/13/08

           SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="       Substitution: "_$$EXTERNAL^DILFD(52,9999999.25,,$GET(PSONEW("DAW")))

 +44      ;IHS/MSC/PLS - 06/04/13

           SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="Discharge Medication: "_$$EXTERNAL^DILFD(52,9999999.28,,$GET(PSONEW("DSCMED")))

 +45      ;IHS/MSC/PLS - 01/23/09

           SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="           Cash Due: "_$$EXTERNAL^DILFD(52,9999999.26,,$GET(PSONEW("CASH DUE")))

 +46      ;S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="            Insurer: "_$G(PSONEW("INSURER"))

 +47      ; End IHS Fields

 +48       IF $GET(PSOSIGFL)!(PSODRUG("OI")'=$PIECE(OR0,"^",8))

               SET PSONEW("CLERK CODE")=DUZ

               SET PSORX("CLERK CODE")=$PIECE(^VA(200,DUZ,0),"^")

               SET VALMSG="This change will create a new prescription!"

 +49       SET $PIECE(RN," ",35)=" "

           SET IEN=IEN+1

           SET ^TMP("PSOPO",$JOB,IEN,0)="   Entry By: "_$PIECE(^VA(200,PSONEW("CLERK CODE"),0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,PSONEW("CLERK CODE"),0),"^"))+1,35)

 +50       SET Y=$PIECE(OR0,"^",12)

           XECUTE ^DD("DD")

           SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"Entry Date: "_$EXTRACT($PIECE(OR0,"^",12),4,5)_"/"_$EXTRACT($PIECE(OR0,"^",12),6,7)_"/"_$EXTRACT($PIECE(OR0,"^",12),2,3)_" "_$PIECE(Y,"@",2)