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

PSORESUS.m

Go to the documentation of this file.
  1. PSORESUS ;BIR/EJW - Queue/Requeue an Rx to CMOP ;Jan 04, 2022@07:41:19
  1. ;;7.0;OUTPATIENT PHARMACY;**264,462,441,753**;DEC 1997;Build 53
  1. ;
  1. ;This routine will allow the last unreleased fill of an Rx to be suspended or resuspended to CMOP.
  1. ;Examples of when this may be used are if the patient was previously marked as "DO NOT MAIL",
  1. ;a drug was recently marked as a CMOP drug, the patient's address was updated to a good address, etc.
  1. ;
  1. TOP ;
  1. S SAVEPPL=$G(PPL)
  1. S DIR(0)="FO^1:15",DIR("A")="Enter the Rx # to queue to CMOP"
  1. S DIR("?")="Enter the prescription number you want to suspend for CMOP dispense."
  1. D ^DIR K DIR I $D(DIRUT) G END
  1. S RX=Y K Y
  1. S PSOIEN=$O(^PSRX("B",RX,"")) I $G(PSOIEN)']"" W !,"Rx # "_RX_" not found" D END G TOP
  1. D SENDRX
  1. I $G(PPL)]"" W !!,$P(^PSRX(PSOIEN,0),"^")," cannot be suspended for CMOP. Make sure the last fill has a Mail routing, the drug is marked for CMOP, the last fill has not been released, etc...",!!
  1. D END G TOP
  1. END K CHECK,CT,DIR,DIROUT,DIRUT,PSOIEN,LAST,NODE,PSX,PSXPPL,PPL,RF,RX,X,Y,ZD,%
  1. K PSXSITEA
  1. I $G(SAVEPPL) S PPL=SAVEPPL K SAVEPPL
  1. Q
  1. CM ; ENTRY POINT FOR SPEED QUEUE/REQUEUE TO CMOP
  1. S SAVEPPL=$G(PPL)
  1. N PSOSTA,II
  1. N PSOOELSE,PSOIEN,VALMCNT
  1. I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
  1. OS K DIR,DUOUT,DIRUT S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR S LST=Y I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
  1. K DIR,DIRUT,DTOUT,PSOOELSE,PSOREPX I '+LST D KILL S VALMBCK="" Q
  1. S PSOOELSE=1 D FULL^VALM1
  1. S PPL="" F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" D
  1. .S ORN=$P(LST,",",ORD),PSOIEN=$P(PSOLST(ORN),"^",2) I $P(PSOLST(ORN),"^",3)'="PENDING" D
  1. ..;S PSOSTA=$P($G(^PSRX(PSOIEN,"STA")),"^") I PSOSTA'=0,PSOSTA'=5 W !!,$P(^PSRX(PSOIEN,0),"^")," is not active or suspended" H 2 Q
  1. ..N PSOQUIT
  1. ..S PSOSTA=$P($G(^PSRX(PSOIEN,"STA")),"^") D Q:PSOQUIT
  1. ... S PSOQUIT=1
  1. ... I PSOSTA'=0,PSOSTA'=5 W !!,$P(^PSRX(PSOIEN,0),"^")," is not active or suspended" H 2 Q
  1. ... I $D(^PSRX(PSOIEN,"PARK")) W !!,$P(^PSRX(PSOIEN,0),"^")," is not active or suspended. Prescription must be unparked to be filled." H 2 Q ;#441 PAPI
  1. ... S PSOQUIT=0
  1. ..I $P($G(^PSRX(PSOIEN,0)),"^",2) S PPL=$S(PPL:PPL_",",1:"")_PSOIEN
  1. ..S VALMBCK="R"
  1. I +PPL S SAVEPPL=PPL F II=1:1 S PSOIEN=$P(SAVEPPL,",",II) Q:PSOIEN="" D
  1. .D SENDRX
  1. .I $G(PPL)]"" W !!,$P(^PSRX(PSOIEN,0),"^")_" cannot be suspended for CMOP. Make sure the last fill has a Mail routing, the drug is marked for CMOP, the last fill has not been released, etc...",! H 2
  1. I '$G(PSOOELSE) S VALMBCK=""
  1. D ^PSOBUILD K SAVEPPL ;PSO*7.0*462
  1. D KILL D KVA^VADPT
  1. Q
  1. ;
  1. KILL ; CLEAN UP VARIABLES
  1. K DIC,LST,ORD,ORN,PSOIEN,PNM,PPL,PSZIP,RX,SSNP,VA,VADDR1,VADM,VAEL,VAPA,VASTREET
  1. I $G(SAVEPPL) S PPL=SAVEPPL K SAVEPPL
  1. Q
  1. ;
  1. SENDRX ; SET RX INTO SUSPENSE FILE FOR CMOP
  1. N LAST,I,TRX,PSOMC,PSOMDT
  1. S LAST=0 I $D(^PSRX(PSOIEN,1)) S I=0 F S I=$O(^PSRX(PSOIEN,1,I)) Q:'I S LAST=I
  1. I $D(PSOSITE) S PSXSITEA=PSOSITE
  1. S PSOSITE=$S(LAST=0:$P(^PSRX(PSOIEN,2),"^",9),1:$P(^PSRX(PSOIEN,1,LAST,0),"^",9))
  1. D NOW^%DTC
  1. N ZD
  1. S PPL=PSOIEN
  1. S TRX=$P($G(PPL),",",1)
  1. S DFN=$P(^PSRX(TRX,0),"^",2),PSOMDT=$P($G(^PS(55,DFN,0)),"^",5),PSOMC=$P($G(^PS(55,DFN,0)),"^",3) K DFN,TRX
  1. I $$GET1^DIQ(52,PSOIEN,100.2,"I")]"" S PSOMC=$$GET1^DIQ(52,PSOIEN,100.2,"I"),PSOMDT="" ;p753
  1. I (PSOMC>1&(PSOMDT>DT))!(PSOMC>1&(PSOMDT<1)) W !,"Cannot suspend for CMOP. Patient's mail status not a CMOP mail status" H 2 K PPL Q
  1. S ZD(PSOIEN)=% D TEST^PSOCMOP H 2
  1. I $G(PSXSITEA)]"" S PSOSITE=PSXSITEA
  1. Q
  1. ;