- 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 Jan 18, 2025@03:35:18 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;