ORWPS1 ; SLC/Staff - Meds Tab ;Aug 09, 2021@10:52:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,539,405**;Dec 17, 1997;Build 211
;
;DBIA SECTION
;4902 - $$PARK^PSO52EX
;
NEWDLG(Y,INPAT) ; Return order dialog info for New Medication
N DGRP,ID,IEN,TXT,TYP,X,X0,X5
I INPAT S X=$$GET^XPAR("ALL","ORWDX NEW MED","i","I")
E S X=$$GET^XPAR("ALL","ORWDX NEW MED","o","I")
S IEN=+X,X0=$G(^ORD(101.41,IEN,0)),X5=$G(^(5))
S TYP=$P(X0,U,4),DGRP=+$P(X0,U,5),ID=+$P(X5,U,5),TXT=$P(X5,U,4)
S Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
Q
PICKUP(Y) ; Return default for refill location
I $D(^PSX(550,"C")) S Y="M"
E S Y="W"
Q
REFILL(Y,ORDERID,REFLOC,ORVP,ORNP,ORL) ; Refill Request
D CHKPARK I UNPARK S Y="" Q ;ADDED LINE OF PAPI CODE
S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2)
D REF^ORMBLDPS(ORDERID,REFLOC)
S Y=""
Q
CHKPARK ; IF ORDER IS PARKED AND LAST FILL HAS NOT PRINTED A LABEL, REUSE LAST FILL INSTEAD OF ORDERING A NEW REFILL - 405
N ERRMSG,ORRFILL
S UNPARK=0,ORRFILL=1
I '$$PARK^PSO52EX(+ORDERID) Q ;ICR 4902
S PSODA=$O(^PSRX("APL",+ORDERID,""))
D UNPARK^PSOPRKA(PSODA,$P(ORVP,";"),.ERRMSG)
I $G(ERRMSG(1))'="" Q
;S UNPARK=1 ;VGH 5/2
Q
NVADLG(Y) ; Return order dialog info for a New Non-VA Medication
N DGRP,ID,IEN,TXT,TYP,X0,X5
S IEN=+$O(^ORD(101.41,"B","PSH OERR",""))
I IEN=0 S Y="-1^PSH OERR (Non VA Medications (Documentation)) dialog does not exist" Q
S X0=$G(^ORD(101.41,IEN,0)),X5=$G(^(5))
S TYP=$P(X0,U,4),DGRP=+$P(X0,U,5),ID=+$P(X5,U,5),TXT=$P(X5,U,4)
S Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPS1 1583 printed Oct 16, 2024@18:37:43 Page 2
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
+2 ;
+3 ;DBIA SECTION
+4 ;4902 - $$PARK^PSO52EX
+5 ;
NEWDLG(Y,INPAT) ; Return order dialog info for New Medication
+1 NEW DGRP,ID,IEN,TXT,TYP,X,X0,X5
+2 IF INPAT
SET X=$$GET^XPAR("ALL","ORWDX NEW MED","i","I")
+3 IF '$TEST
SET X=$$GET^XPAR("ALL","ORWDX NEW MED","o","I")
+4 SET IEN=+X
SET X0=$GET(^ORD(101.41,IEN,0))
SET X5=$GET(^(5))
+5 SET TYP=$PIECE(X0,U,4)
SET DGRP=+$PIECE(X0,U,5)
SET ID=+$PIECE(X5,U,5)
SET TXT=$PIECE(X5,U,4)
+6 SET Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
+7 QUIT
PICKUP(Y) ; Return default for refill location
+1 IF $DATA(^PSX(550,"C"))
SET Y="M"
+2 IF '$TEST
SET Y="W"
+3 QUIT
REFILL(Y,ORDERID,REFLOC,ORVP,ORNP,ORL) ; Refill Request
+1 ;ADDED LINE OF PAPI CODE
DO CHKPARK
IF UNPARK
SET Y=""
QUIT
+2 SET ORVP=ORVP_";DPT("
SET ORL(2)=ORL_";SC("
SET ORL=ORL(2)
+3 DO REF^ORMBLDPS(ORDERID,REFLOC)
+4 SET Y=""
+5 QUIT
CHKPARK ; IF ORDER IS PARKED AND LAST FILL HAS NOT PRINTED A LABEL, REUSE LAST FILL INSTEAD OF ORDERING A NEW REFILL - 405
+1 NEW ERRMSG,ORRFILL
+2 SET UNPARK=0
SET ORRFILL=1
+3 ;ICR 4902
IF '$$PARK^PSO52EX(+ORDERID)
QUIT
+4 SET PSODA=$ORDER(^PSRX("APL",+ORDERID,""))
+5 DO UNPARK^PSOPRKA(PSODA,$PIECE(ORVP,";"),.ERRMSG)
+6 IF $GET(ERRMSG(1))'=""
QUIT
+7 ;S UNPARK=1 ;VGH 5/2
+8 QUIT
NVADLG(Y) ; Return order dialog info for a New Non-VA Medication
+1 NEW DGRP,ID,IEN,TXT,TYP,X0,X5
+2 SET IEN=+$ORDER(^ORD(101.41,"B","PSH OERR",""))
+3 IF IEN=0
SET Y="-1^PSH OERR (Non VA Medications (Documentation)) dialog does not exist"
QUIT
+4 SET X0=$GET(^ORD(101.41,IEN,0))
SET X5=$GET(^(5))
+5 SET TYP=$PIECE(X0,U,4)
SET DGRP=+$PIECE(X0,U,5)
SET ID=+$PIECE(X5,U,5)
SET TXT=$PIECE(X5,U,4)
+6 SET Y=IEN_";"_ID_";"_DGRP_";"_TYP_U_TXT
+7 QUIT
