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)
KILL RN
+51 IF PSOLMC<2
DO ^PSOLMPO1
SET VALMBCK="Q"
SET PSOLMC=0
+52 IF PSOLMC>1
SET VALMBCK="R"
+53 QUIT
ORCHK DO PROVCOM^PSOORFI4
DO ORCHK^PSOORFI4
+1 QUIT
+2 ; 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))
+1 DO KV
SET DIR("A",1)="* Indicates which fields will create an new Order"
SET DIR("A")="Select Field to Edit by number"
SET DIR(0)="LO^0:15"
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
EDTSEL NEW LST,FLD,OUT
DO KV
SET OUT=0
+1 ; IHS/CIA/PLS - 01/26/04 - Allow zero
+2 ;I +Y S LST=Y D FULL^VALM1 N PSODOSE M PSODOSE=PSONEW D G DSPL
+3 IF $LENGTH(Y)
SET LST=Y
DO FULL^VALM1
NEW PSODOSE
MERGE PSODOSE=PSONEW
Begin DoDot:1
+4 FOR FLD=1:1:$LENGTH(LST,",")
IF $PIECE(LST,",",FLD)']""!(OUT)
QUIT
DO @(+$PIECE(LST,",",FLD))
IF $PIECE(LST,",",FLD)=8
DO REF
DO KV
End DoDot:1
GOTO DSPL
+5 IF '$TEST
SET VALMBCK=""
QUIT
+6 QUIT
ACP ;
+1 IF $GET(ORD)
IF +$PIECE($GET(^PS(52.41,+ORD,0)),"^",23)=1
Begin DoDot:1
+2 DO FULL^VALM1
DO KV
+3 SET DIR("A",1)="This Order is flagged. In order to finish it"
+4 SET DIR("A",2)="you must unflag it first."
+5 SET DIR("A",3)=""
+6 SET DIR(0)="Y"
SET DIR("A")="Unflag Order"
SET DIR("B")="NO"
+7 WRITE !
DO ^DIR
IF $DATA(DIRUT)!'Y
SET VALMBCK="Q"
End DoDot:1
IF $DATA(DIRUT)!'Y
QUIT
DO EN1^ORCFLAG(+$PIECE($GET(^PS(52.41,ORD,0)),"^"))
HANG 1
+8 IF $GET(ORD)
IF +$PIECE($GET(^PS(52.41,+ORD,0)),"^",23)=1
QUIT
+9 ;
+10 IF $DATA(CLOZPAT)
IF +$GET(PSONEW("QTY"))=0
SET VALMSG="Unable to calculate the quantity, enter a quantity"
GOTO DSPL
+11 SET (PSODIR("DFLG"),PSORX("DFLG"),PSODIR("QFLD"))=0
SET ACP=1
DO ORCHK
+12 IF $GET(PSONEW("QFLG"))
GOTO DSPL
+13 IF $GET(PSODIR("DFLG"))!$GET(PSORX("DFLG"))
QUIT
+14 IF $GET(PSONEW("FLD"))!($GET(PSODRUG("NAME"))']"")!('$ORDER(SIG(0)))
GOTO DSPL
+15 IF $GET(PSODRUG("NAME"))]""
IF '$GET(ORCHK)!($GET(ORDRG)'=PSODRUG("NAME"))
Begin DoDot:1
+16 DO POST^PSODRG
IF '$GET(PSORX("DFLG"))
SET ORCHK=1
SET ORDRG=PSODRUG("NAME")
End DoDot:1
IF $GET(PSORX("DFLG"))
DO CLEAN^PSOVER1
GOTO DSPL
+17 IF '$DATA(PSONEW("RX #"))
SET PSOFROM="NEW"
SET RTN=$SELECT($PIECE($GET(PSOPAR),"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN")
DO @RTN
IF PSONEW("QFLG")
QUIT
IF '$PIECE($GET(PSOPAR),"^",7)
SET PSOX=PSONEW("RX #")
DO CHECK^PSONRXN
+18 DO RXNCHK^PSOORNE1
IF $GET(PSONEW("QFLG"))
SET PSONEW("DFLG")=1
QUIT
+19 IF DT>$$FMADD^XLFDT($PIECE(OR0,"^",6),365)
DO EXPR^PSONEW2
GOTO DSPL
+20 DO STOP^PSONEW2
DO DISPLAY^PSONEW2
DO ^PSONEWF
+21 IF $GET(PSOCPZ("DFLG"))
WRITE !!,"No action taken!",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
DO KV
KILL PSOCPZ("DFLG"),DRET,PSOANSQD
SET VALMBCK="Q"
QUIT
+22 ;
+23 KILL PSOCPZ("DFLG")
DO KV
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to Accept this Order"
SET DIR("B")="NO"
DO ^DIR
IF $DATA(DIRUT)
DO KV
KILL DRET,PSOANSQ,PSOANSQD
SET VALMBCK="Q"
QUIT
+24 DO KV
IF 'Y
KILL PSOANSQ
GOTO DSPL
+25 IF $GET(PSONEW("MAIL/WINDOW"))["W"
IF $PIECE($GET(PSOPAR),"^",12)
Begin DoDot:1
+26 WRITE !
KILL DIR,DIRUT
SET DIR(0)="52,35O"
+27 IF $GET(PSORX("METHOD OF PICK-UP"))]""
SET DIR("B")=PSORX("METHOD OF PICK-UP")
DO ^DIR
IF $DATA(DIRUT)
KILL DIR,DIRUT
QUIT
+28 SET (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y
KILL X,Y
End DoDot:1
SET BINGCRT="Y"
SET BINGRTE="W"
SET PSORX("MAIL/WINDOW")="WINDOW"
KILL RTN
+29 SET PSONEW("POE")=1
DO EN^PSON52(.PSONEW)
IF $GET(PSONEW("DFLG"))
GOTO ABORT
DO DCORD^PSONEW2
+30 DO EN^APSPPCC1(PSODFN,PSONEW("IRXN"))
+31 DO DCORD^PSONEW2
+32 DO NPSOSD^PSOUTIL(.PSONEW)
DO FULL^VALM1
KILL PSORX("MAIL/WINDOW")
+33 DO EOJ^PSONEW
ABORT SET VALMBCK="Q"
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
DO CLEAN^PSOVER1
DO KV
+1 QUIT
KV KILL DIRUT,DUOUT,DTOUT,DIR
+1 QUIT
REF DO REF^PSOORFI4
+1 QUIT
0 ; EP - IHS/CIA/PLS - 01/26/04 - Prompt IHS Fields
+1 DO IHSFLDS^APSPDIR(.PSONEW)
QUIT
+2 ;
1 ;oi
NEW PSOBDR,PSOBDRG
SET PSOBDRG=1
DO 1^PSOORNW2
QUIT
+1 ;
4 DO INS^PSOORNW2
QUIT
+1 ;
3 DO DOSE^PSOORED4(.PSONEW)
QUIT
+1 ;
6 ;idt
DO 4^PSOORNW2
QUIT
+1 ;
7 ;fdt
DO 5^PSOORNW2
QUIT
+1 ;
5 ;pstat
DO 3^PSOORNW2
QUIT
+1 ;
13 ;doc
DO 12^PSOORNW2
QUIT
+1 ;
12 ;cli
DO 11^PSOORNW2
QUIT
+1 ;
2 NEW PSOCSIG
IF '$GET(PSOBDRG)
NEW PSOBDR,PSOBDRG
SET PSOBDRG=1
+1 ;drg/ICD
DO 2^PSOORNW1
IF $GET(PSOQFLG)
QUIT
DO EN^PSODIAG
+2 IF $GET(PSOCSIG)
KILL PSOCSIG
GOTO 3
+3 QUIT
+4 ;
9 ;qty
DO 8^PSOORNW2
QUIT
+1 ;
8 ;ds
DO 7^PSOORNW2
QUIT
+1 ;
10 ;#rfs
DO 9^PSOORNW2
QUIT
+1 ;
14 ;cop
DO 13^PSOORNW2
QUIT
+1 ;
11 ;m/w
DO 10^PSOORNW2
QUIT
+1 ;
15 ;rem
DO 14^PSOORNW2
QUIT
+1 ;
DRGMSG ;
+1 FOR SG=1:1:$LENGTH($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10))
IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",20)=" "
Begin DoDot:1
+2 IF $PIECE($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'=""
SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)
End DoDot:1
+3 KILL SG
QUIT
