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

ORWPS1.m

Go to the documentation of this file.
  1. ORWPS1 ; SLC/Staff - Meds Tab ;Aug 09, 2021@10:52:15
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,539,405**;Dec 17, 1997;Build 211
  1. ;
  1. ;DBIA SECTION
  1. ;4902 - $$PARK^PSO52EX
  1. ;
  1. NEWDLG(Y,INPAT) ; Return order dialog info for New Medication
  1. N DGRP,ID,IEN,TXT,TYP,X,X0,X5
  1. I INPAT S X=$$GET^XPAR("ALL","ORWDX NEW MED","i","I")
  1. E S X=$$GET^XPAR("ALL","ORWDX NEW MED","o","I")
  1. S IEN=+X,X0=$G(^ORD(101.41,IEN,0)),X5=$G(^(5))
  1. S TYP=$P(X0,U,4),DGRP=+$P(X0,U,5),ID=+$P(X5,U,5),TXT=$P(X5,U,4)
  1. S Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
  1. Q
  1. PICKUP(Y) ; Return default for refill location
  1. I $D(^PSX(550,"C")) S Y="M"
  1. E S Y="W"
  1. Q
  1. REFILL(Y,ORDERID,REFLOC,ORVP,ORNP,ORL) ; Refill Request
  1. D CHKPARK I UNPARK S Y="" Q ;ADDED LINE OF PAPI CODE
  1. S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2)
  1. D REF^ORMBLDPS(ORDERID,REFLOC)
  1. S Y=""
  1. Q
  1. CHKPARK ; IF ORDER IS PARKED AND LAST FILL HAS NOT PRINTED A LABEL, REUSE LAST FILL INSTEAD OF ORDERING A NEW REFILL - 405
  1. N ERRMSG,ORRFILL
  1. S UNPARK=0,ORRFILL=1
  1. I '$$PARK^PSO52EX(+ORDERID) Q ;ICR 4902
  1. S PSODA=$O(^PSRX("APL",+ORDERID,""))
  1. D UNPARK^PSOPRKA(PSODA,$P(ORVP,";"),.ERRMSG)
  1. I $G(ERRMSG(1))'="" Q
  1. ;S UNPARK=1 ;VGH 5/2
  1. Q
  1. NVADLG(Y) ; Return order dialog info for a New Non-VA Medication
  1. N DGRP,ID,IEN,TXT,TYP,X0,X5
  1. S IEN=+$O(^ORD(101.41,"B","PSH OERR",""))
  1. I IEN=0 S Y="-1^PSH OERR (Non VA Medications (Documentation)) dialog does not exist" Q
  1. S X0=$G(^ORD(101.41,IEN,0)),X5=$G(^(5))
  1. S TYP=$P(X0,U,4),DGRP=+$P(X0,U,5),ID=+$P(X5,U,5),TXT=$P(X5,U,4)
  1. S Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
  1. Q