Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSONEW1

PSONEW1.m

Go to the documentation of this file.
  1. 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
  1. ;External reference ^PS(55 supported by DBIA 2228
  1. ;
  1. START ;
  1. S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW1)=0
  1. ;
  1. 1 S PSONEW("FLD")=1 S PSONEW("FIELD")=0
  1. I $P($G(PSOPAR),"^",7)'=1 D MANUAL^PSONRXN ; Get Manual Rx number
  1. G:PSONEW("QFLG")!PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 2 S PSONEW("FLD")=2 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 3 S PSONEW("FLD")=3 D ^PSODRG ; Get drug and related information
  1. G:PSONEW("DFLG") END D EN^PSODIAG ; get ICD diagnosis codes for order
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. ;/RBN - BEGIN CHANGES PSO*7.0*457
  1. 31 I $D(^TMP($J,"CLOZFLG",PSODFN)) D ; Get Dosing
  1. . S PSONEW("# OF REFILLS")=0
  1. . S PSONEW("DAYS SUPPLY")=4
  1. . ;Removed default dose for new Clozapine orders PSO*7.0*574
  1. . ;S PSONEW("DOSE",1)=100
  1. . S PSONEW("DOSE ORDERED",1)=1
  1. . ;S PSONEW("DURATION",1)=4 ; to remove "FOR 4 DAYS" from the SIG ; PSO*7.0*574
  1. . S PSONEW("QTY")=4
  1. . S PSONEW("ENT")=1
  1. . S CLOZFLG=1 ; /MZR Added it to assure check for duration in PSOORED5
  1. S PSONEW("FLD")=31 D DOSE^PSODIR(.PSONEW) ; Get Dosing
  1. ;/RBN - END CHANGES PSO*7.0*457
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 32 K PSODELINS
  1. I '$G(PSONEW("ENT")) W !,"Incomplete Dosaging Data!",! K DIRUT G 31
  1. S:'$D(PSOOEINS) PSOOEINS=$G(PSONEW("INS")) S:'$D(PSOOSINS) PSOOSINS=$G(PSONEW("SINS"))
  1. S:'$D(PSOOEIND) PSOOEIND=$G(PSONEW("IND")) S:'$D(PSOOINDF) PSOOINDF=$G(PSONEW("INDF")) S:'$D(PSOOSIND) PSOOSIND=$G(PSONEW("SIND")) ;*441
  1. I '$P($G(^PS(55,PSODFN,"LAN")),"^") S PSONEW("FLD")=32 D INS^PSODIR(.PSONEW) ; Get Patient Instructions
  1. I $P($G(^PS(55,PSODFN,"LAN")),"^") D
  1. .N PSOINSCH,PSODONE S PSODONE=0
  1. .F D I PSODONE D SIND^PSODIR(.PSONEW) Q
  1. ..S PSONEW("FLD")=32 D INS^PSODIR(.PSONEW)
  1. ..I '$G(PSONEW("DFLG")),'PSODONE,'$G(PSODELINS) D SINS^PSODIR(.PSONEW)
  1. ..I $G(PSONEW("DFLG")) S PSODONE=1 D Q
  1. ...I $G(PSONEW("INS"))]"",$G(PSONEW("SINS"))="" K PSONEW("INS"),PSONEW("SIG") Q
  1. ...I $G(PSONEW("INS"))="",$G(PSONEW("SINS"))]"" K PSONEW("SINS")
  1. ..S PSOINSCH=$$INSCHK^PSOHELP3(.PSONEW)
  1. ..I 'PSOINSCH S PSODONE=1
  1. G:$G(PSONEW("DFLG")) END G:$G(PSONEW("FIELD")) @PSONEW("FIELD")
  1. ;
  1. ;
  1. 4 D EN^PSOFSIG(.PSONEW) I $O(SIG(0)) S SIGOK=1
  1. ;S PSONEW("FLD")=4 D SIG^PSODIR1(.PSONEW) ; Get Rx directions
  1. ;G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 7 S PSONEW("FLD")=7 D DAYS^PSODIR1(.PSONEW) ; Get days supply
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 5 S PSONEW("FLD")=5 D QTY^PSODIR1(.PSONEW) ; Get quantity
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 6 I $P($G(PSOPAR),"^",15) S PSONEW("FLD")=6 D COPIES^PSODIR1(.PSONEW) ; Get label copies
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 8 I $G(^TMP($J,"CLOZFLG",PSODFN)) G 9 ; PSO*7.0*457
  1. S PSONEW("FLD")=8 D REFILL^PSODIR1(.PSONEW) ; Get # of refills
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 9 S PSONEW("FLD")=9 D PROV^PSODIR(.PSONEW) ; Get Provider
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. G:$G(DUZ("AG"))'="I" 11
  1. ;
  1. 10 Q:$G(DUZ("AG"))'="I" S PSONEW("FLD")=10 D EXP^PSODIR2(.PSONEW) ; Get Expiration Date - Indian Health Service ONLY
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 11 S PSONEW("FLD")=11 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 12 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 13 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ; Get Remarks
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 14 S PSONEW("FLD")=14 D ISSDT^PSODIR2(.PSONEW) ; Get Issue Date
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 15 S PSONEW("FLD")=15 D FILLDT^PSODIR2(.PSONEW) ; Get Fill date
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. 16 S PSONEW("FLD")=16 D CLERK^PSODIR2(.PSONEW) ; Get Clerk Code
  1. G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1. ;
  1. END ;
  1. K PSONEW1,PSOOEINS,PSOOSINS,^TMP($J,"CLOZFLG",PSODFN),PSOOEIND,PSOOINDF,PSOOSIND ;*441
  1. Q
  1. ;
  1. JUMP ;
  1. 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"))
  1. I PSONEW("FIELD")>PSONEW("FLD") W !,$C(7),"Cannot jump ahead ..",! S PSONEW("FIELD")=PSONEW("FLD")
  1. Q