PSOVCCA ;BIR/JLC,KML - VCC PRESCRIPTION REFILL APIS ; Nov 22, 2023@13:04:43
;;7.0;OUTPATIENT PHARMACY;**642,679,712,745**;DEC 1997;Build 23
;
; Reference to PSOL^PSSLOCK,PSOUL^PSSLOCK in ICR #2789
Q
AP1(PSORET,PSODFN,PSORX,PSOUSER,PSORFSRC,PSORTFLG) ;ACCEPT REQUEST
; Input: PSODFN (required) - Patient IEN Number
; PSORX (required) - Prescription Number
; PSOUSER (optional) - User requesting refill
; PSORFSRC (optional) - the source system from which the REFILL
; request Originated (e.g., VCC, CPRS, VSE)
; PSORTFLG (optional) - 1 or empty (null) - the return flag; if = 1 then the RPC will
; return the numeric code with the error text; if = null
; then the RPC will only return the numeric code (-5, -4, -3, 0, or 1 )
; Output: PSORET - Return Value
; See IA# 7313 for description and values
;
; route processing to appropriate tag
I $G(PSORTFLG)="" D SIMPLE($G(PSODFN),$G(PSORX),$G(PSOUSER),$G(PSORFSRC)) Q
D EXPANDED($G(PSODFN),$G(PSORX),$G(PSOUSER),$G(PSORFSRC))
Q
;
SIMPLE(PSODFN,PSORX,PSOUSER,PSORFSRC) ;
;NOTE: if no refill source is passed, the assumption will be that
;the source is the VAHC-CRM platform (fka VCC). This is to ensure
;backwards compatibility until the changes are made to the CRM
;system to pass in the source and request the expanded error messages
N PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE,ERR,PSOITMG
I $G(PSORFSRC)="" S PSORFSRC="CRM"
I $G(PSODFN)="" S PSORET(0)=-4 G QUITAP1
S PSOICN=+$$GETICN^MPIF001(PSODFN)
I +$G(PSOICN)=-1 S PSORET(0)=-4 G QUITAP1
I $G(PSORX)="" S PSORET(0)=-3 G QUITAP1
I $O(^PSRX("B",PSORX,""))="" S PSORET(0)=-3 G QUITAP1
I '$D(^PSRX("B",PSORX)) S PSORET(0)=-3 G QUITAP1
S PSRX=$O(^PSRX("B",PSORX,"")),PSRXD=$G(^PSRX(PSRX,0))
I PSRXD="" S PSORET(0)=-3 G QUITAP1
I $P(PSRXD,"^",2)'=PSODFN S PSORET(0)=-5 G QUITAP1
D PSOL^PSSLOCK(PSRX) I '$G(PSOMSG) K PSOMSG S PSORET(0)=-8 G QUITAP1
D PSOUL^PSSLOCK(PSRX)
N UNPARK,PSOTIT,ERRMSG S (UNPARK,PSOTIT)=0
D CHKPARK I $D(ERRMSG) S PSORET(0)=-8 G QUITAP1
I PSOTIT D G QUITAP1
.I PSOTIT=1 S PSORET(0)=-6
.I PSOTIT=2 S PSORET(0)=-7
I $G(UNPARK) S PSORET(0)=1 Q ;*712
D REF^PSOATRFV(PSRX,PSOUSER,PSORFSRC,.ERR)
I $D(ERR) S PSORET(0)=0 Q
S PSORET(0)=1
QUITAP1 Q
;
EXPANDED(PSODFN,PSORX,PSOUSER,PSORFSRC) ;
N PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE,ERR,X1,PSOITMG
I $G(PSODFN)="" S PSORET(0)="-4 - Missing or Invalid Patient ID" Q
S PSOICN=+$$GETICN^MPIF001(PSODFN)
I +$G(PSOICN)=-1 S PSORET(0)="-6 - Patient is not assigned an ICN" Q
I $G(PSORX)="" S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
I $O(^PSRX("B",PSORX,""))="" S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
I '$D(^PSRX("B",PSORX)) S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
S PSRX=$O(^PSRX("B",PSORX,"")),PSRXD=$G(^PSRX(PSRX,0))
I PSRXD="" S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
I $P(PSRXD,"^",2)'=PSODFN S PSORET(0)="-5 - Prescription Number does not match to the Patient" Q
D PSOL^PSSLOCK(PSRX) I '$G(PSOMSG) K PSOMSG S PSORET(0)="-8 - Prescription unavailable - try again later" Q
D PSOUL^PSSLOCK(PSRX)
N UNPARK,PSOTIT,ERRMSG S (UNPARK,PSOTIT)=0
D CHKPARK I $D(ERRMSG) S PSORET(0)="-8 - Prescription unavailable - try again later" Q
I PSOTIT D Q
.I PSOTIT=1 S PSORET(0)="-6 -'Titration Rx' cannot be refilled."
.I PSOTIT=2 S PSORET(0)="-7 - No more refills left."
I $G(UNPARK) S PSORET(0)="1 - Prescription is unparked and placed in Suspended status" Q ;*712
D REF^PSOATRFV(PSRX,PSOUSER,PSORFSRC,.ERR)
I $D(ERR) S PSORET(0)=0 M PSORET=ERR Q
S PSORET(0)="1 - Prescription successfully refilled"
Q
;
CHKPARK ; if order is parked and last fill label is not printed, reuse the last fill instead of placing a new refill *712
N ORRFILL,DA,PSOZF
S ORRFILL=1,DA=PSRX
I $G(^PSRX(DA,"STA"))'=0 Q
I $G(^PSRX(DA,"PARK"))'=1 Q
; *712 PAPI - don't quit here if filling original parked titration
I $$TITRX^PSOUTL(DA)="t",'$$CHKPRKORIG^PSOPRKA(DA) S PSOTIT=1 Q
I $P(^PSRX(DA,0),"^",9)=0 D Q:PSOTIT
.D GETRELDT^PSOPRKA(DA) I RSDT S PSOTIT=2 Q
.D CHKLBL^PSOPRKA(DA,0) I LBLP S PSOTIT=2 Q
.D ^PSOCMOPA I $D(PSOCMOP) S PSOTIT=2
I $P(^PSRX(DA,0),"^",9)>0 D Q:PSOTIT
.N NRF S NRF=$P(^PSRX(DA,0),"^",9)
.S PSOZF=+$O(^PSRX(DA,1,99999),-1) Q:'PSOZF
.D GETRELDT^PSOPRKA(DA)
.I RSDT D Q
..I NRF>PSOZF Q
..E S PSOTIT=2 Q
.D CHKLBL^PSOPRKA(DA,PSOZF)
.I LBLP D Q
..I NRF>PSOZF Q
..E S PSOTIT=2 Q
.D ^PSOCMOPA
.I $D(PSOCMOP) D
..I NRF>PSOZF Q
..E S PSOTIT=2 Q
D UNPARK^PSOPRKA(PSRX,PSODFN,.ERRMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOVCCA 4764 printed Oct 16, 2024@18:36:51 Page 2
PSOVCCA ;BIR/JLC,KML - VCC PRESCRIPTION REFILL APIS ; Nov 22, 2023@13:04:43
+1 ;;7.0;OUTPATIENT PHARMACY;**642,679,712,745**;DEC 1997;Build 23
+2 ;
+3 ; Reference to PSOL^PSSLOCK,PSOUL^PSSLOCK in ICR #2789
+4 QUIT
AP1(PSORET,PSODFN,PSORX,PSOUSER,PSORFSRC,PSORTFLG) ;ACCEPT REQUEST
+1 ; Input: PSODFN (required) - Patient IEN Number
+2 ; PSORX (required) - Prescription Number
+3 ; PSOUSER (optional) - User requesting refill
+4 ; PSORFSRC (optional) - the source system from which the REFILL
+5 ; request Originated (e.g., VCC, CPRS, VSE)
+6 ; PSORTFLG (optional) - 1 or empty (null) - the return flag; if = 1 then the RPC will
+7 ; return the numeric code with the error text; if = null
+8 ; then the RPC will only return the numeric code (-5, -4, -3, 0, or 1 )
+9 ; Output: PSORET - Return Value
+10 ; See IA# 7313 for description and values
+11 ;
+12 ; route processing to appropriate tag
+13 IF $GET(PSORTFLG)=""
DO SIMPLE($GET(PSODFN),$GET(PSORX),$GET(PSOUSER),$GET(PSORFSRC))
QUIT
+14 DO EXPANDED($GET(PSODFN),$GET(PSORX),$GET(PSOUSER),$GET(PSORFSRC))
+15 QUIT
+16 ;
SIMPLE(PSODFN,PSORX,PSOUSER,PSORFSRC) ;
+1 ;NOTE: if no refill source is passed, the assumption will be that
+2 ;the source is the VAHC-CRM platform (fka VCC). This is to ensure
+3 ;backwards compatibility until the changes are made to the CRM
+4 ;system to pass in the source and request the expanded error messages
+5 NEW PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE,ERR,PSOITMG
+6 IF $GET(PSORFSRC)=""
SET PSORFSRC="CRM"
+7 IF $GET(PSODFN)=""
SET PSORET(0)=-4
GOTO QUITAP1
+8 SET PSOICN=+$$GETICN^MPIF001(PSODFN)
+9 IF +$GET(PSOICN)=-1
SET PSORET(0)=-4
GOTO QUITAP1
+10 IF $GET(PSORX)=""
SET PSORET(0)=-3
GOTO QUITAP1
+11 IF $ORDER(^PSRX("B",PSORX,""))=""
SET PSORET(0)=-3
GOTO QUITAP1
+12 IF '$DATA(^PSRX("B",PSORX))
SET PSORET(0)=-3
GOTO QUITAP1
+13 SET PSRX=$ORDER(^PSRX("B",PSORX,""))
SET PSRXD=$GET(^PSRX(PSRX,0))
+14 IF PSRXD=""
SET PSORET(0)=-3
GOTO QUITAP1
+15 IF $PIECE(PSRXD,"^",2)'=PSODFN
SET PSORET(0)=-5
GOTO QUITAP1
+16 DO PSOL^PSSLOCK(PSRX)
IF '$GET(PSOMSG)
KILL PSOMSG
SET PSORET(0)=-8
GOTO QUITAP1
+17 DO PSOUL^PSSLOCK(PSRX)
+18 NEW UNPARK,PSOTIT,ERRMSG
SET (UNPARK,PSOTIT)=0
+19 DO CHKPARK
IF $DATA(ERRMSG)
SET PSORET(0)=-8
GOTO QUITAP1
+20 IF PSOTIT
Begin DoDot:1
+21 IF PSOTIT=1
SET PSORET(0)=-6
+22 IF PSOTIT=2
SET PSORET(0)=-7
End DoDot:1
GOTO QUITAP1
+23 ;*712
IF $GET(UNPARK)
SET PSORET(0)=1
QUIT
+24 DO REF^PSOATRFV(PSRX,PSOUSER,PSORFSRC,.ERR)
+25 IF $DATA(ERR)
SET PSORET(0)=0
QUIT
+26 SET PSORET(0)=1
QUITAP1 QUIT
+1 ;
EXPANDED(PSODFN,PSORX,PSOUSER,PSORFSRC) ;
+1 NEW PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE,ERR,X1,PSOITMG
+2 IF $GET(PSODFN)=""
SET PSORET(0)="-4 - Missing or Invalid Patient ID"
QUIT
+3 SET PSOICN=+$$GETICN^MPIF001(PSODFN)
+4 IF +$GET(PSOICN)=-1
SET PSORET(0)="-6 - Patient is not assigned an ICN"
QUIT
+5 IF $GET(PSORX)=""
SET PSORET(0)="-3 - Missing or Invalid Prescription Number"
QUIT
+6 IF $ORDER(^PSRX("B",PSORX,""))=""
SET PSORET(0)="-3 - Missing or Invalid Prescription Number"
QUIT
+7 IF '$DATA(^PSRX("B",PSORX))
SET PSORET(0)="-3 - Missing or Invalid Prescription Number"
QUIT
+8 SET PSRX=$ORDER(^PSRX("B",PSORX,""))
SET PSRXD=$GET(^PSRX(PSRX,0))
+9 IF PSRXD=""
SET PSORET(0)="-3 - Missing or Invalid Prescription Number"
QUIT
+10 IF $PIECE(PSRXD,"^",2)'=PSODFN
SET PSORET(0)="-5 - Prescription Number does not match to the Patient"
QUIT
+11 DO PSOL^PSSLOCK(PSRX)
IF '$GET(PSOMSG)
KILL PSOMSG
SET PSORET(0)="-8 - Prescription unavailable - try again later"
QUIT
+12 DO PSOUL^PSSLOCK(PSRX)
+13 NEW UNPARK,PSOTIT,ERRMSG
SET (UNPARK,PSOTIT)=0
+14 DO CHKPARK
IF $DATA(ERRMSG)
SET PSORET(0)="-8 - Prescription unavailable - try again later"
QUIT
+15 IF PSOTIT
Begin DoDot:1
+16 IF PSOTIT=1
SET PSORET(0)="-6 -'Titration Rx' cannot be refilled."
+17 IF PSOTIT=2
SET PSORET(0)="-7 - No more refills left."
End DoDot:1
QUIT
+18 ;*712
IF $GET(UNPARK)
SET PSORET(0)="1 - Prescription is unparked and placed in Suspended status"
QUIT
+19 DO REF^PSOATRFV(PSRX,PSOUSER,PSORFSRC,.ERR)
+20 IF $DATA(ERR)
SET PSORET(0)=0
MERGE PSORET=ERR
QUIT
+21 SET PSORET(0)="1 - Prescription successfully refilled"
+22 QUIT
+23 ;
CHKPARK ; if order is parked and last fill label is not printed, reuse the last fill instead of placing a new refill *712
+1 NEW ORRFILL,DA,PSOZF
+2 SET ORRFILL=1
SET DA=PSRX
+3 IF $GET(^PSRX(DA,"STA"))'=0
QUIT
+4 IF $GET(^PSRX(DA,"PARK"))'=1
QUIT
+5 ; *712 PAPI - don't quit here if filling original parked titration
+6 IF $$TITRX^PSOUTL(DA)="t"
IF '$$CHKPRKORIG^PSOPRKA(DA)
SET PSOTIT=1
QUIT
+7 IF $PIECE(^PSRX(DA,0),"^",9)=0
Begin DoDot:1
+8 DO GETRELDT^PSOPRKA(DA)
IF RSDT
SET PSOTIT=2
QUIT
+9 DO CHKLBL^PSOPRKA(DA,0)
IF LBLP
SET PSOTIT=2
QUIT
+10 DO ^PSOCMOPA
IF $DATA(PSOCMOP)
SET PSOTIT=2
End DoDot:1
if PSOTIT
QUIT
+11 IF $PIECE(^PSRX(DA,0),"^",9)>0
Begin DoDot:1
+12 NEW NRF
SET NRF=$PIECE(^PSRX(DA,0),"^",9)
+13 SET PSOZF=+$ORDER(^PSRX(DA,1,99999),-1)
if 'PSOZF
QUIT
+14 DO GETRELDT^PSOPRKA(DA)
+15 IF RSDT
Begin DoDot:2
+16 IF NRF>PSOZF
QUIT
+17 IF '$TEST
SET PSOTIT=2
QUIT
End DoDot:2
QUIT
+18 DO CHKLBL^PSOPRKA(DA,PSOZF)
+19 IF LBLP
Begin DoDot:2
+20 IF NRF>PSOZF
QUIT
+21 IF '$TEST
SET PSOTIT=2
QUIT
End DoDot:2
QUIT
+22 DO ^PSOCMOPA
+23 IF $DATA(PSOCMOP)
Begin DoDot:2
+24 IF NRF>PSOZF
QUIT
+25 IF '$TEST
SET PSOTIT=2
QUIT
End DoDot:2
End DoDot:1
if PSOTIT
QUIT
+26 DO UNPARK^PSOPRKA(PSRX,PSODFN,.ERRMSG)
+27 QUIT
