PSORPC01 ;INN/AA - PAPI INTERFACE ROUTINES ;Dec 06, 2021@15:55:23
;;7.0;OUTPATIENT PHARMACY;**441**;DEC 1997;Build 208
;
;Ref. ^PSDRUG( supp. DBIA 221
;Ref. GET^XPAR supp. DBIA 2263
;Ref. EDITPAR^XPAREDIT supp. DBIA 2336
;
RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6) ; [Procedure] Main RPC call
; based on MD* routines
N ERR
S RESULTS=$NA(^TMP("PSORPC01",$J)) K @RESULTS
I '($T(@OPTION)]"") S @RESULTS@(0)="-1^Option '"_OPTION_"' not found in routine '"_$T(+0)_"'." Q
D @OPTION
D CLEAN^DILF
Q
;
ECHO ;
;
S @RESULTS@(0)=OPTION
S @RESULTS@(1)="P1:"_P1
S @RESULTS@(2)="P2:"_P2
S @RESULTS@(3)="P3:"_P3
S @RESULTS@(4)="P4:"_P4
S @RESULTS@(5)="P5:"_P5
S @RESULTS@(6)="P6:"_P6
Q
;
GETPARK(PSOPRK) ; Check if parking is available for the site
N PSOPARST S PSOPARST="SYS^PKG"
I +$G(PSOPINST) S PSOPARST=PSOPINST_";DIC(4,^"_PSOPARST ; if outpatient site related institution is defined use it in parameter check
I PSOPARST="SYS^PKG" S PSOPARST="DIV^SYS^PKG"
S @RESULTS@(0)=$S($$GET^XPAR(PSOPARST,"PSO PARK ON",,"E")="YES":"YES",1:"NO")
Q
;
SETPARK ;TURN PARK A PRESCRIPTION ON OR OFF
D EDITPAR^XPAREDIT("PSO PARK ON")
Q
;
PARK ;
;
S PSODA=$O(^PSRX("APL",+P1,""))
I PSODA D PARK^PSOPRKA(PSODA)
K PSODA
Q
;
UNPARK ;
;
S PSODA=$O(^PSRX("APL",+P1,"")) I PSODA="" Q
D UNPARK^PSOPRKA(PSODA,+P3,.ERRMSG)
I $G(ERRMSG(1))'="" S @RESULTS@(0)=ERRMSG(1)
K ERRMSG,PSODA
Q
;
PARKDRG ; Check if drug is marked as not parkable (new CPRS order)
S @RESULTS@(0)=1
I '$G(P1) Q
I ($P($G(^PSDRUG(P1,0)),"^",3)["D")!($P($G(^PSDRUG(P1,0)),"^",1)["CLOZAPINE") S @RESULTS@(0)="0^Drug is defined as not parkable"
;I $P($G(^PSDRUG(P1,0)),"^",1)["CLOZAPINE" S @RESULTS@(0)="0^"_$P($G(^PSDRUG(P1,0)),"^",1)_" is not a parkable medication"
;B Q
Q
;
PARKORD ; Check if drug belonging to order# is marked as not parkable (CPRS renewal)
S @RESULTS@(0)=1
I '$G(P1) Q
N DRUG
S PSODA=$O(^PSRX("APL",+P1,"")) I PSODA="" Q
S DRUG=$P($G(^PSRX(PSODA,0)),"^",6) I 'DRUG Q
I ($P($G(^PSDRUG(DRUG,0)),"^",3)["D")!($P($G(^PSDRUG(DRUG,0)),"^",1)["CLOZAPINE") S @RESULTS@(0)="0^Drug is defined as not parkable"
Q
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;NAME: PSORPC TAG: RPC
; ROUTINE: PSORPC01 RETURN VALUE TYPE: GLOBAL ARRAY
; AVAILABILITY: PUBLIC INACTIVE: ACTIVE
; VERSION: 1
;INPUT PARAMETER: OPTION PARAMETER TYPE: LITERAL
; MAXIMUM DATA LENGTH: 8 REQUIRED: YES
; SEQUENCE NUMBER: 1
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORPC01 2698 printed Apr 09, 2024@21:27:01 Page 2
PSORPC01 ;INN/AA - PAPI INTERFACE ROUTINES ;Dec 06, 2021@15:55:23
+1 ;;7.0;OUTPATIENT PHARMACY;**441**;DEC 1997;Build 208
+2 ;
+3 ;Ref. ^PSDRUG( supp. DBIA 221
+4 ;Ref. GET^XPAR supp. DBIA 2263
+5 ;Ref. EDITPAR^XPAREDIT supp. DBIA 2336
+6 ;
RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6) ; [Procedure] Main RPC call
+1 ; based on MD* routines
+2 NEW ERR
+3 SET RESULTS=$NAME(^TMP("PSORPC01",$JOB))
KILL @RESULTS
+4 IF '($TEXT(@OPTION)]"")
SET @RESULTS@(0)="-1^Option '"_OPTION_"' not found in routine '"_$TEXT(+0)_"'."
QUIT
+5 DO @OPTION
+6 DO CLEAN^DILF
+7 QUIT
+8 ;
ECHO ;
+1 ;
+2 SET @RESULTS@(0)=OPTION
+3 SET @RESULTS@(1)="P1:"_P1
+4 SET @RESULTS@(2)="P2:"_P2
+5 SET @RESULTS@(3)="P3:"_P3
+6 SET @RESULTS@(4)="P4:"_P4
+7 SET @RESULTS@(5)="P5:"_P5
+8 SET @RESULTS@(6)="P6:"_P6
+9 QUIT
+10 ;
GETPARK(PSOPRK) ; Check if parking is available for the site
+1 NEW PSOPARST
SET PSOPARST="SYS^PKG"
+2 ; if outpatient site related institution is defined use it in parameter check
IF +$GET(PSOPINST)
SET PSOPARST=PSOPINST_";DIC(4,^"_PSOPARST
+3 IF PSOPARST="SYS^PKG"
SET PSOPARST="DIV^SYS^PKG"
+4 SET @RESULTS@(0)=$SELECT($$GET^XPAR(PSOPARST,"PSO PARK ON",,"E")="YES":"YES",1:"NO")
+5 QUIT
+6 ;
SETPARK ;TURN PARK A PRESCRIPTION ON OR OFF
+1 DO EDITPAR^XPAREDIT("PSO PARK ON")
+2 QUIT
+3 ;
PARK ;
+1 ;
+2 SET PSODA=$ORDER(^PSRX("APL",+P1,""))
+3 IF PSODA
DO PARK^PSOPRKA(PSODA)
+4 KILL PSODA
+5 QUIT
+6 ;
UNPARK ;
+1 ;
+2 SET PSODA=$ORDER(^PSRX("APL",+P1,""))
IF PSODA=""
QUIT
+3 DO UNPARK^PSOPRKA(PSODA,+P3,.ERRMSG)
+4 IF $GET(ERRMSG(1))'=""
SET @RESULTS@(0)=ERRMSG(1)
+5 KILL ERRMSG,PSODA
+6 QUIT
+7 ;
PARKDRG ; Check if drug is marked as not parkable (new CPRS order)
+1 SET @RESULTS@(0)=1
+2 IF '$GET(P1)
QUIT
+3 IF ($PIECE($GET(^PSDRUG(P1,0)),"^",3)["D")!($PIECE($GET(^PSDRUG(P1,0)),"^",1)["CLOZAPINE")
SET @RESULTS@(0)="0^Drug is defined as not parkable"
+4 ;I $P($G(^PSDRUG(P1,0)),"^",1)["CLOZAPINE" S @RESULTS@(0)="0^"_$P($G(^PSDRUG(P1,0)),"^",1)_" is not a parkable medication"
+5 ;B Q
+6 QUIT
+7 ;
PARKORD ; Check if drug belonging to order# is marked as not parkable (CPRS renewal)
+1 SET @RESULTS@(0)=1
+2 IF '$GET(P1)
QUIT
+3 NEW DRUG
+4 SET PSODA=$ORDER(^PSRX("APL",+P1,""))
IF PSODA=""
QUIT
+5 SET DRUG=$PIECE($GET(^PSRX(PSODA,0)),"^",6)
IF 'DRUG
QUIT
+6 IF ($PIECE($GET(^PSDRUG(DRUG,0)),"^",3)["D")!($PIECE($GET(^PSDRUG(DRUG,0)),"^",1)["CLOZAPINE")
SET @RESULTS@(0)="0^Drug is defined as not parkable"
+7 QUIT
+8 ;
+9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+10 ;
+11 ;NAME: PSORPC TAG: RPC
+12 ; ROUTINE: PSORPC01 RETURN VALUE TYPE: GLOBAL ARRAY
+13 ; AVAILABILITY: PUBLIC INACTIVE: ACTIVE
+14 ; VERSION: 1
+15 ;INPUT PARAMETER: OPTION PARAMETER TYPE: LITERAL
+16 ; MAXIMUM DATA LENGTH: 8 REQUIRED: YES
+17 ; SEQUENCE NUMBER: 1
+18 ;
+19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
