PSONEW1 ;BIR/DSD - new Rx order entry ;Apr 08, 2020@10:02:06
;;7.0;OUTPATIENT PHARMACY;**46,104,117,143,422,457,574,441**;DEC 1997;Build 208
;External reference ^PS(55 supported by DBIA 2228
;
START ;
S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW1)=0
;
1 S PSONEW("FLD")=1 S PSONEW("FIELD")=0
I $P($G(PSOPAR),"^",7)'=1 D MANUAL^PSONRXN ; Get Manual Rx number
G:PSONEW("QFLG")!PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
2 S PSONEW("FLD")=2 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
3 S PSONEW("FLD")=3 D ^PSODRG ; Get drug and related information
G:PSONEW("DFLG") END D EN^PSODIAG ; get ICD diagnosis codes for order
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
;/RBN - BEGIN CHANGES PSO*7.0*457
31 I $D(^TMP($J,"CLOZFLG",PSODFN)) D ; Get Dosing
. S PSONEW("# OF REFILLS")=0
. S PSONEW("DAYS SUPPLY")=4
. ;Removed default dose for new Clozapine orders PSO*7.0*574
. ;S PSONEW("DOSE",1)=100
. S PSONEW("DOSE ORDERED",1)=1
. ;S PSONEW("DURATION",1)=4 ; to remove "FOR 4 DAYS" from the SIG ; PSO*7.0*574
. S PSONEW("QTY")=4
. S PSONEW("ENT")=1
. S CLOZFLG=1 ; /MZR Added it to assure check for duration in PSOORED5
S PSONEW("FLD")=31 D DOSE^PSODIR(.PSONEW) ; Get Dosing
;/RBN - END CHANGES PSO*7.0*457
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
32 K PSODELINS
I '$G(PSONEW("ENT")) W !,"Incomplete Dosaging Data!",! K DIRUT G 31
S:'$D(PSOOEINS) PSOOEINS=$G(PSONEW("INS")) S:'$D(PSOOSINS) PSOOSINS=$G(PSONEW("SINS"))
S:'$D(PSOOEIND) PSOOEIND=$G(PSONEW("IND")) S:'$D(PSOOINDF) PSOOINDF=$G(PSONEW("INDF")) S:'$D(PSOOSIND) PSOOSIND=$G(PSONEW("SIND")) ;*441
I '$P($G(^PS(55,PSODFN,"LAN")),"^") S PSONEW("FLD")=32 D INS^PSODIR(.PSONEW) ; Get Patient Instructions
I $P($G(^PS(55,PSODFN,"LAN")),"^") D
.N PSOINSCH,PSODONE S PSODONE=0
.F D I PSODONE D SIND^PSODIR(.PSONEW) Q
..S PSONEW("FLD")=32 D INS^PSODIR(.PSONEW)
..I '$G(PSONEW("DFLG")),'PSODONE,'$G(PSODELINS) D SINS^PSODIR(.PSONEW)
..I $G(PSONEW("DFLG")) S PSODONE=1 D Q
...I $G(PSONEW("INS"))]"",$G(PSONEW("SINS"))="" K PSONEW("INS"),PSONEW("SIG") Q
...I $G(PSONEW("INS"))="",$G(PSONEW("SINS"))]"" K PSONEW("SINS")
..S PSOINSCH=$$INSCHK^PSOHELP3(.PSONEW)
..I 'PSOINSCH S PSODONE=1
G:$G(PSONEW("DFLG")) END G:$G(PSONEW("FIELD")) @PSONEW("FIELD")
;
;
4 D EN^PSOFSIG(.PSONEW) I $O(SIG(0)) S SIGOK=1
;S PSONEW("FLD")=4 D SIG^PSODIR1(.PSONEW) ; Get Rx directions
;G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
7 S PSONEW("FLD")=7 D DAYS^PSODIR1(.PSONEW) ; Get days supply
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
5 S PSONEW("FLD")=5 D QTY^PSODIR1(.PSONEW) ; Get quantity
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
6 I $P($G(PSOPAR),"^",15) S PSONEW("FLD")=6 D COPIES^PSODIR1(.PSONEW) ; Get label copies
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
8 I $G(^TMP($J,"CLOZFLG",PSODFN)) G 9 ; PSO*7.0*457
S PSONEW("FLD")=8 D REFILL^PSODIR1(.PSONEW) ; Get # of refills
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
9 S PSONEW("FLD")=9 D PROV^PSODIR(.PSONEW) ; Get Provider
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
G:$G(DUZ("AG"))'="I" 11
;
10 Q:$G(DUZ("AG"))'="I" S PSONEW("FLD")=10 D EXP^PSODIR2(.PSONEW) ; Get Expiration Date - Indian Health Service ONLY
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
11 S PSONEW("FLD")=11 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
12 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
13 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ; Get Remarks
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
14 S PSONEW("FLD")=14 D ISSDT^PSODIR2(.PSONEW) ; Get Issue Date
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
15 S PSONEW("FLD")=15 D FILLDT^PSODIR2(.PSONEW) ; Get Fill date
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
16 S PSONEW("FLD")=16 D CLERK^PSODIR2(.PSONEW) ; Get Clerk Code
G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
;
END ;
K PSONEW1,PSOOEINS,PSOOSINS,^TMP($J,"CLOZFLG",PSODFN),PSOOEIND,PSOOINDF,PSOOSIND ;*441
Q
;
JUMP ;
S PSONEW("FIELD")=$S(+Y=.01:1,+Y=3:2,+Y=6:3,+Y=10:4,+Y=7:5,+Y=10.6:6,+Y=8:7,+Y=9:8,+Y=4:9,+Y=29:10,+Y=5:11,+Y=11:12,+Y=12:13,+Y=1:14,+Y=22:15,+Y=16:16,+Y=113:31,+Y=114:32,1:PSONEW("FLD"))
I PSONEW("FIELD")>PSONEW("FLD") W !,$C(7),"Cannot jump ahead ..",! S PSONEW("FIELD")=PSONEW("FLD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSONEW1 4641 printed Sep 23, 2025@20:07:47 Page 2
PSONEW1 ;BIR/DSD - new Rx order entry ;Apr 08, 2020@10:02:06
+1 ;;7.0;OUTPATIENT PHARMACY;**46,104,117,143,422,457,574,441**;DEC 1997;Build 208
+2 ;External reference ^PS(55 supported by DBIA 2228
+3 ;
START ;
+1 SET (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW1)=0
+2 ;
1 SET PSONEW("FLD")=1
SET PSONEW("FIELD")=0
+1 ; Get Manual Rx number
IF $PIECE($GET(PSOPAR),"^",7)'=1
DO MANUAL^PSONRXN
+2 if PSONEW("QFLG")!PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+3 ;
2 ; Get Patient Status
SET PSONEW("FLD")=2
DO PTSTAT^PSODIR1(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
3 ; Get drug and related information
SET PSONEW("FLD")=3
DO ^PSODRG
+1 ; get ICD diagnosis codes for order
if PSONEW("DFLG")
GOTO END
DO EN^PSODIAG
+2 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+3 ;
+4 ;/RBN - BEGIN CHANGES PSO*7.0*457
31 ; Get Dosing
IF $DATA(^TMP($JOB,"CLOZFLG",PSODFN))
Begin DoDot:1
+1 SET PSONEW("# OF REFILLS")=0
+2 SET PSONEW("DAYS SUPPLY")=4
+3 ;Removed default dose for new Clozapine orders PSO*7.0*574
+4 ;S PSONEW("DOSE",1)=100
+5 SET PSONEW("DOSE ORDERED",1)=1
+6 ;S PSONEW("DURATION",1)=4 ; to remove "FOR 4 DAYS" from the SIG ; PSO*7.0*574
+7 SET PSONEW("QTY")=4
+8 SET PSONEW("ENT")=1
+9 ; /MZR Added it to assure check for duration in PSOORED5
SET CLOZFLG=1
End DoDot:1
+10 ; Get Dosing
SET PSONEW("FLD")=31
DO DOSE^PSODIR(.PSONEW)
+11 ;/RBN - END CHANGES PSO*7.0*457
+12 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+13 ;
32 KILL PSODELINS
+1 IF '$GET(PSONEW("ENT"))
WRITE !,"Incomplete Dosaging Data!",!
KILL DIRUT
GOTO 31
+2 if '$DATA(PSOOEINS)
SET PSOOEINS=$GET(PSONEW("INS"))
if '$DATA(PSOOSINS)
SET PSOOSINS=$GET(PSONEW("SINS"))
+3 ;*441
if '$DATA(PSOOEIND)
SET PSOOEIND=$GET(PSONEW("IND"))
if '$DATA(PSOOINDF)
SET PSOOINDF=$GET(PSONEW("INDF"))
if '$DATA(PSOOSIND)
SET PSOOSIND=$GET(PSONEW("SIND"))
+4 ; Get Patient Instructions
IF '$PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
SET PSONEW("FLD")=32
DO INS^PSODIR(.PSONEW)
+5 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
Begin DoDot:1
+6 NEW PSOINSCH,PSODONE
SET PSODONE=0
+7 FOR
Begin DoDot:2
+8 SET PSONEW("FLD")=32
DO INS^PSODIR(.PSONEW)
+9 IF '$GET(PSONEW("DFLG"))
IF 'PSODONE
IF '$GET(PSODELINS)
DO SINS^PSODIR(.PSONEW)
+10 IF $GET(PSONEW("DFLG"))
SET PSODONE=1
Begin DoDot:3
+11 IF $GET(PSONEW("INS"))]""
IF $GET(PSONEW("SINS"))=""
KILL PSONEW("INS"),PSONEW("SIG")
QUIT
+12 IF $GET(PSONEW("INS"))=""
IF $GET(PSONEW("SINS"))]""
KILL PSONEW("SINS")
End DoDot:3
QUIT
+13 SET PSOINSCH=$$INSCHK^PSOHELP3(.PSONEW)
+14 IF 'PSOINSCH
SET PSODONE=1
End DoDot:2
IF PSODONE
DO SIND^PSODIR(.PSONEW)
QUIT
End DoDot:1
+15 if $GET(PSONEW("DFLG"))
GOTO END
if $GET(PSONEW("FIELD"))
GOTO @PSONEW("FIELD")
+16 ;
+17 ;
4 DO EN^PSOFSIG(.PSONEW)
IF $ORDER(SIG(0))
SET SIGOK=1
+1 ;S PSONEW("FLD")=4 D SIG^PSODIR1(.PSONEW) ; Get Rx directions
+2 ;G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
+3 ;
7 ; Get days supply
SET PSONEW("FLD")=7
DO DAYS^PSODIR1(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
5 ; Get quantity
SET PSONEW("FLD")=5
DO QTY^PSODIR1(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
6 ; Get label copies
IF $PIECE($GET(PSOPAR),"^",15)
SET PSONEW("FLD")=6
DO COPIES^PSODIR1(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
8 ; PSO*7.0*457
IF $GET(^TMP($JOB,"CLOZFLG",PSODFN))
GOTO 9
+1 ; Get # of refills
SET PSONEW("FLD")=8
DO REFILL^PSODIR1(.PSONEW)
+2 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+3 ;
9 ; Get Provider
SET PSONEW("FLD")=9
DO PROV^PSODIR(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 if $GET(DUZ("AG"))'="I"
GOTO 11
+3 ;
10 ; Get Expiration Date - Indian Health Service ONLY
if $GET(DUZ("AG"))'="I"
QUIT
SET PSONEW("FLD")=10
DO EXP^PSODIR2(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
11 ; Get Clinic
SET PSONEW("FLD")=11
DO CLINIC^PSODIR2(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
12 ; Get Mail/Window Info
SET PSONEW("FLD")=12
DO MW^PSODIR2(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
13 ; Get Remarks
SET PSONEW("FLD")=13
DO RMK^PSODIR2(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
14 ; Get Issue Date
SET PSONEW("FLD")=14
DO ISSDT^PSODIR2(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
15 ; Get Fill date
SET PSONEW("FLD")=15
DO FILLDT^PSODIR2(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
16 ; Get Clerk Code
SET PSONEW("FLD")=16
DO CLERK^PSODIR2(.PSONEW)
+1 if PSONEW("DFLG")
GOTO END
if PSONEW("FIELD")
GOTO @PSONEW("FIELD")
+2 ;
END ;
+1 ;*441
KILL PSONEW1,PSOOEINS,PSOOSINS,^TMP($JOB,"CLOZFLG",PSODFN),PSOOEIND,PSOOINDF,PSOOSIND
+2 QUIT
+3 ;
JUMP ;
+1 SET PSONEW("FIELD")=$SELECT(+Y=.01:1,+Y=3:2,+Y=6:3,+Y=10:4,+Y=7:5,+Y=10.6:6,+Y=8:7,+Y=9:8,+Y=4:9,+Y=29:10,+Y=5:11,+Y=11:12,+Y=12:13,+Y=1:14,+Y=22:15,+Y=16:16,+Y=113:31,+Y=114:32,1:PSONEW("FLD"))
+2 IF PSONEW("FIELD")>PSONEW("FLD")
WRITE !,$CHAR(7),"Cannot jump ahead ..",!
SET PSONEW("FIELD")=PSONEW("FLD")
+3 QUIT
