Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOVCCA

PSOVCCA.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to PSOL^PSSLOCK,PSOUL^PSSLOCK in ICR #2789
  1. Q
  1. AP1(PSORET,PSODFN,PSORX,PSOUSER,PSORFSRC,PSORTFLG) ;ACCEPT REQUEST
  1. ; Input: PSODFN (required) - Patient IEN Number
  1. ; PSORX (required) - Prescription Number
  1. ; PSOUSER (optional) - User requesting refill
  1. ; PSORFSRC (optional) - the source system from which the REFILL
  1. ; request Originated (e.g., VCC, CPRS, VSE)
  1. ; PSORTFLG (optional) - 1 or empty (null) - the return flag; if = 1 then the RPC will
  1. ; return the numeric code with the error text; if = null
  1. ; then the RPC will only return the numeric code (-5, -4, -3, 0, or 1 )
  1. ; Output: PSORET - Return Value
  1. ; See IA# 7313 for description and values
  1. ;
  1. ; route processing to appropriate tag
  1. I $G(PSORTFLG)="" D SIMPLE($G(PSODFN),$G(PSORX),$G(PSOUSER),$G(PSORFSRC)) Q
  1. D EXPANDED($G(PSODFN),$G(PSORX),$G(PSOUSER),$G(PSORFSRC))
  1. Q
  1. ;
  1. SIMPLE(PSODFN,PSORX,PSOUSER,PSORFSRC) ;
  1. ;NOTE: if no refill source is passed, the assumption will be that
  1. ;the source is the VAHC-CRM platform (fka VCC). This is to ensure
  1. ;backwards compatibility until the changes are made to the CRM
  1. ;system to pass in the source and request the expanded error messages
  1. N PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE,ERR,PSOITMG
  1. I $G(PSORFSRC)="" S PSORFSRC="CRM"
  1. I $G(PSODFN)="" S PSORET(0)=-4 G QUITAP1
  1. S PSOICN=+$$GETICN^MPIF001(PSODFN)
  1. I +$G(PSOICN)=-1 S PSORET(0)=-4 G QUITAP1
  1. I $G(PSORX)="" S PSORET(0)=-3 G QUITAP1
  1. I $O(^PSRX("B",PSORX,""))="" S PSORET(0)=-3 G QUITAP1
  1. I '$D(^PSRX("B",PSORX)) S PSORET(0)=-3 G QUITAP1
  1. S PSRX=$O(^PSRX("B",PSORX,"")),PSRXD=$G(^PSRX(PSRX,0))
  1. I PSRXD="" S PSORET(0)=-3 G QUITAP1
  1. I $P(PSRXD,"^",2)'=PSODFN S PSORET(0)=-5 G QUITAP1
  1. D PSOL^PSSLOCK(PSRX) I '$G(PSOMSG) K PSOMSG S PSORET(0)=-8 G QUITAP1
  1. D PSOUL^PSSLOCK(PSRX)
  1. N UNPARK,PSOTIT,ERRMSG S (UNPARK,PSOTIT)=0
  1. D CHKPARK I $D(ERRMSG) S PSORET(0)=-8 G QUITAP1
  1. I PSOTIT D G QUITAP1
  1. .I PSOTIT=1 S PSORET(0)=-6
  1. .I PSOTIT=2 S PSORET(0)=-7
  1. I $G(UNPARK) S PSORET(0)=1 Q ;*712
  1. D REF^PSOATRFV(PSRX,PSOUSER,PSORFSRC,.ERR)
  1. I $D(ERR) S PSORET(0)=0 Q
  1. S PSORET(0)=1
  1. QUITAP1 Q
  1. ;
  1. EXPANDED(PSODFN,PSORX,PSOUSER,PSORFSRC) ;
  1. N PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE,ERR,X1,PSOITMG
  1. I $G(PSODFN)="" S PSORET(0)="-4 - Missing or Invalid Patient ID" Q
  1. S PSOICN=+$$GETICN^MPIF001(PSODFN)
  1. I +$G(PSOICN)=-1 S PSORET(0)="-6 - Patient is not assigned an ICN" Q
  1. I $G(PSORX)="" S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
  1. I $O(^PSRX("B",PSORX,""))="" S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
  1. I '$D(^PSRX("B",PSORX)) S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
  1. S PSRX=$O(^PSRX("B",PSORX,"")),PSRXD=$G(^PSRX(PSRX,0))
  1. I PSRXD="" S PSORET(0)="-3 - Missing or Invalid Prescription Number" Q
  1. I $P(PSRXD,"^",2)'=PSODFN S PSORET(0)="-5 - Prescription Number does not match to the Patient" Q
  1. D PSOL^PSSLOCK(PSRX) I '$G(PSOMSG) K PSOMSG S PSORET(0)="-8 - Prescription unavailable - try again later" Q
  1. D PSOUL^PSSLOCK(PSRX)
  1. N UNPARK,PSOTIT,ERRMSG S (UNPARK,PSOTIT)=0
  1. D CHKPARK I $D(ERRMSG) S PSORET(0)="-8 - Prescription unavailable - try again later" Q
  1. I PSOTIT D Q
  1. .I PSOTIT=1 S PSORET(0)="-6 -'Titration Rx' cannot be refilled."
  1. .I PSOTIT=2 S PSORET(0)="-7 - No more refills left."
  1. I $G(UNPARK) S PSORET(0)="1 - Prescription is unparked and placed in Suspended status" Q ;*712
  1. D REF^PSOATRFV(PSRX,PSOUSER,PSORFSRC,.ERR)
  1. I $D(ERR) S PSORET(0)=0 M PSORET=ERR Q
  1. S PSORET(0)="1 - Prescription successfully refilled"
  1. Q
  1. ;
  1. CHKPARK ; if order is parked and last fill label is not printed, reuse the last fill instead of placing a new refill *712
  1. N ORRFILL,DA,PSOZF
  1. S ORRFILL=1,DA=PSRX
  1. I $G(^PSRX(DA,"STA"))'=0 Q
  1. I $G(^PSRX(DA,"PARK"))'=1 Q
  1. ; *712 PAPI - don't quit here if filling original parked titration
  1. I $$TITRX^PSOUTL(DA)="t",'$$CHKPRKORIG^PSOPRKA(DA) S PSOTIT=1 Q
  1. I $P(^PSRX(DA,0),"^",9)=0 D Q:PSOTIT
  1. .D GETRELDT^PSOPRKA(DA) I RSDT S PSOTIT=2 Q
  1. .D CHKLBL^PSOPRKA(DA,0) I LBLP S PSOTIT=2 Q
  1. .D ^PSOCMOPA I $D(PSOCMOP) S PSOTIT=2
  1. I $P(^PSRX(DA,0),"^",9)>0 D Q:PSOTIT
  1. .N NRF S NRF=$P(^PSRX(DA,0),"^",9)
  1. .S PSOZF=+$O(^PSRX(DA,1,99999),-1) Q:'PSOZF
  1. .D GETRELDT^PSOPRKA(DA)
  1. .I RSDT D Q
  1. ..I NRF>PSOZF Q
  1. ..E S PSOTIT=2 Q
  1. .D CHKLBL^PSOPRKA(DA,PSOZF)
  1. .I LBLP D Q
  1. ..I NRF>PSOZF Q
  1. ..E S PSOTIT=2 Q
  1. .D ^PSOCMOPA
  1. .I $D(PSOCMOP) D
  1. ..I NRF>PSOZF Q
  1. ..E S PSOTIT=2 Q
  1. D UNPARK^PSOPRKA(PSRX,PSODFN,.ERRMSG)
  1. Q