| [613] | 1 | PSORESUS ;BIR/EJW Queue/Requeue an Rx to CMOP ;07/25/07
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**264**;DEC 1997;Build 19
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine will allow the last unreleased fill of an Rx to be suspended or resuspended to CMOP.
|
|---|
| 5 | ;Examples of when this may be used are if the patient was previously marked as "DO NOT MAIL",
|
|---|
| 6 | ;a drug was recently marked as a CMOP drug, the patient's address was updated to a good address, etc.
|
|---|
| 7 | ;
|
|---|
| 8 | TOP ;
|
|---|
| 9 | S SAVEPPL=$G(PPL)
|
|---|
| 10 | S DIR(0)="FO^1:15",DIR("A")="Enter the Rx # to queue to CMOP"
|
|---|
| 11 | S DIR("?")="Enter the prescription number you want to suspend for CMOP dispense."
|
|---|
| 12 | D ^DIR K DIR I $D(DIRUT) G END
|
|---|
| 13 | S RX=Y K Y
|
|---|
| 14 | S PSOIEN=$O(^PSRX("B",RX,"")) I $G(PSOIEN)']"" W !,"Rx # "_RX_" not found" D END G TOP
|
|---|
| 15 | D SENDRX
|
|---|
| 16 | 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...",!!
|
|---|
| 17 | D END G TOP
|
|---|
| 18 | END K CHECK,CT,DIR,DIROUT,DIRUT,PSOIEN,LAST,NODE,PSX,PSXPPL,PPL,RF,RX,X,Y,ZD,%
|
|---|
| 19 | K PSXSITEA
|
|---|
| 20 | I $G(SAVEPPL) S PPL=SAVEPPL K SAVEPPL
|
|---|
| 21 | Q
|
|---|
| 22 | CM ; ENTRY POINT FOR SPEED QUEUE/REQUEUE TO CMOP
|
|---|
| 23 | S SAVEPPL=$G(PPL)
|
|---|
| 24 | N PSOSTA,II
|
|---|
| 25 | N PSOOELSE,PSOIEN,VALMCNT
|
|---|
| 26 | I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
|
|---|
| 27 | 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
|
|---|
| 28 | K DIR,DIRUT,DTOUT,PSOOELSE,PSOREPX I '+LST D KILL S VALMBCK="" Q
|
|---|
| 29 | S PSOOELSE=1 D FULL^VALM1
|
|---|
| 30 | S PPL="" F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" D
|
|---|
| 31 | .S ORN=$P(LST,",",ORD),PSOIEN=$P(PSOLST(ORN),"^",2) I $P(PSOLST(ORN),"^",3)'="PENDING" D
|
|---|
| 32 | ..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
|
|---|
| 33 | ..I $P($G(^PSRX(PSOIEN,0)),"^",2) S PPL=$S(PPL:PPL_",",1:"")_PSOIEN
|
|---|
| 34 | ..S VALMBCK="R"
|
|---|
| 35 | I +PPL S SAVEPPL=PPL F II=1:1 S PSOIEN=$P(SAVEPPL,",",II) Q:PSOIEN="" D
|
|---|
| 36 | .D SENDRX
|
|---|
| 37 | .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
|
|---|
| 38 | I '$G(PSOOELSE) S VALMBCK=""
|
|---|
| 39 | D ^PSOBUILD
|
|---|
| 40 | D KILL D KVA^VADPT
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | KILL ; CLEAN UP VARIABLES
|
|---|
| 44 | K DIC,LST,ORD,ORN,PSOIEN,PNM,PPL,PSZIP,RX,SSNP,VA,VADDR1,VADM,VAEL,VAPA,VASTREET
|
|---|
| 45 | I $G(SAVEPPL) S PPL=SAVEPPL K SAVEPPL
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | SENDRX ; SET RX INTO SUSPENSE FILE FOR CMOP
|
|---|
| 49 | N LAST,I,TRX,PSOMC,PSOMDT
|
|---|
| 50 | S LAST=0 I $D(^PSRX(PSOIEN,1)) S I=0 F S I=$O(^PSRX(PSOIEN,1,I)) Q:'I S LAST=I
|
|---|
| 51 | I $D(PSOSITE) S PSXSITEA=PSOSITE
|
|---|
| 52 | S PSOSITE=$S(LAST=0:$P(^PSRX(PSOIEN,2),"^",9),1:$P(^PSRX(PSOIEN,1,LAST,0),"^",9))
|
|---|
| 53 | D NOW^%DTC
|
|---|
| 54 | N ZD
|
|---|
| 55 | S PPL=PSOIEN
|
|---|
| 56 | S TRX=$P($G(PPL),",",1)
|
|---|
| 57 | 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
|
|---|
| 58 | 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
|
|---|
| 59 | S ZD(PSOIEN)=% D TEST^PSOCMOP H 2
|
|---|
| 60 | I $G(PSXSITEA)]"" S PSOSITE=PSXSITEA
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
