- 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 Feb 18, 2025@23:57:48 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