- 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 Feb 19, 2025@00:03:41 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