- 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 Jan 18, 2025@03:37:21 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