- PSORESUS ;BIR/EJW - Queue/Requeue an Rx to CMOP ;Jan 04, 2022@07:41:19
- ;;7.0;OUTPATIENT PHARMACY;**264,462,441,753**;DEC 1997;Build 53
- ;
- ;This routine will allow the last unreleased fill of an Rx to be suspended or resuspended to CMOP.
- ;Examples of when this may be used are if the patient was previously marked as "DO NOT MAIL",
- ;a drug was recently marked as a CMOP drug, the patient's address was updated to a good address, etc.
- ;
- TOP ;
- S SAVEPPL=$G(PPL)
- S DIR(0)="FO^1:15",DIR("A")="Enter the Rx # to queue to CMOP"
- S DIR("?")="Enter the prescription number you want to suspend for CMOP dispense."
- D ^DIR K DIR I $D(DIRUT) G END
- S RX=Y K Y
- S PSOIEN=$O(^PSRX("B",RX,"")) I $G(PSOIEN)']"" W !,"Rx # "_RX_" not found" D END G TOP
- D SENDRX
- 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...",!!
- D END G TOP
- END K CHECK,CT,DIR,DIROUT,DIRUT,PSOIEN,LAST,NODE,PSX,PSXPPL,PPL,RF,RX,X,Y,ZD,%
- K PSXSITEA
- I $G(SAVEPPL) S PPL=SAVEPPL K SAVEPPL
- Q
- CM ; ENTRY POINT FOR SPEED QUEUE/REQUEUE TO CMOP
- S SAVEPPL=$G(PPL)
- N PSOSTA,II
- N PSOOELSE,PSOIEN,VALMCNT
- I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
- 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
- K DIR,DIRUT,DTOUT,PSOOELSE,PSOREPX I '+LST D KILL S VALMBCK="" Q
- S PSOOELSE=1 D FULL^VALM1
- S PPL="" F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" D
- .S ORN=$P(LST,",",ORD),PSOIEN=$P(PSOLST(ORN),"^",2) I $P(PSOLST(ORN),"^",3)'="PENDING" D
- ..;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
- ..N PSOQUIT
- ..S PSOSTA=$P($G(^PSRX(PSOIEN,"STA")),"^") D Q:PSOQUIT
- ... S PSOQUIT=1
- ... I PSOSTA'=0,PSOSTA'=5 W !!,$P(^PSRX(PSOIEN,0),"^")," is not active or suspended" H 2 Q
- ... 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
- ... S PSOQUIT=0
- ..I $P($G(^PSRX(PSOIEN,0)),"^",2) S PPL=$S(PPL:PPL_",",1:"")_PSOIEN
- ..S VALMBCK="R"
- I +PPL S SAVEPPL=PPL F II=1:1 S PSOIEN=$P(SAVEPPL,",",II) Q:PSOIEN="" D
- .D SENDRX
- .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
- I '$G(PSOOELSE) S VALMBCK=""
- D ^PSOBUILD K SAVEPPL ;PSO*7.0*462
- D KILL D KVA^VADPT
- Q
- ;
- KILL ; CLEAN UP VARIABLES
- K DIC,LST,ORD,ORN,PSOIEN,PNM,PPL,PSZIP,RX,SSNP,VA,VADDR1,VADM,VAEL,VAPA,VASTREET
- I $G(SAVEPPL) S PPL=SAVEPPL K SAVEPPL
- Q
- ;
- SENDRX ; SET RX INTO SUSPENSE FILE FOR CMOP
- N LAST,I,TRX,PSOMC,PSOMDT
- S LAST=0 I $D(^PSRX(PSOIEN,1)) S I=0 F S I=$O(^PSRX(PSOIEN,1,I)) Q:'I S LAST=I
- I $D(PSOSITE) S PSXSITEA=PSOSITE
- S PSOSITE=$S(LAST=0:$P(^PSRX(PSOIEN,2),"^",9),1:$P(^PSRX(PSOIEN,1,LAST,0),"^",9))
- D NOW^%DTC
- N ZD
- S PPL=PSOIEN
- S TRX=$P($G(PPL),",",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
- I $$GET1^DIQ(52,PSOIEN,100.2,"I")]"" S PSOMC=$$GET1^DIQ(52,PSOIEN,100.2,"I"),PSOMDT="" ;p753
- 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
- S ZD(PSOIEN)=% D TEST^PSOCMOP H 2
- I $G(PSXSITEA)]"" S PSOSITE=PSXSITEA
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORESUS 3592 printed Feb 19, 2025@00:00:17 Page 2
- 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
- +2 ;
- +3 ;This routine will allow the last unreleased fill of an Rx to be suspended or resuspended to CMOP.
- +4 ;Examples of when this may be used are if the patient was previously marked as "DO NOT MAIL",
- +5 ;a drug was recently marked as a CMOP drug, the patient's address was updated to a good address, etc.
- +6 ;
- TOP ;
- +1 SET SAVEPPL=$GET(PPL)
- +2 SET DIR(0)="FO^1:15"
- SET DIR("A")="Enter the Rx # to queue to CMOP"
- +3 SET DIR("?")="Enter the prescription number you want to suspend for CMOP dispense."
- +4 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO END
- +5 SET RX=Y
- KILL Y
- +6 SET PSOIEN=$ORDER(^PSRX("B",RX,""))
- IF $GET(PSOIEN)']""
- WRITE !,"Rx # "_RX_" not found"
- DO END
- GOTO TOP
- +7 DO SENDRX
- +8 IF $GET(PPL)]""
- WRITE !!,$PIECE(^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...",!!
- +9 DO END
- GOTO TOP
- END KILL CHECK,CT,DIR,DIROUT,DIRUT,PSOIEN,LAST,NODE,PSX,PSXPPL,PPL,RF,RX,X,Y,ZD,%
- +1 KILL PSXSITEA
- +2 IF $GET(SAVEPPL)
- SET PPL=SAVEPPL
- KILL SAVEPPL
- +3 QUIT
- CM ; ENTRY POINT FOR SPEED QUEUE/REQUEUE TO CMOP
- +1 SET SAVEPPL=$GET(PPL)
- +2 NEW PSOSTA,II
- +3 NEW PSOOELSE,PSOIEN,VALMCNT
- +4 IF '$GET(PSOCNT)
- SET VALMSG="This patient has no Prescriptions!"
- SET VALMBCK=""
- QUIT
- OS KILL DIR,DUOUT,DIRUT
- SET DIR("A")="Select Orders by number"
- SET DIR(0)="LO^1:"_PSOCNT
- DO ^DIR
- SET LST=Y
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DIR,DIRUT,DTOUT,DUOUT
- SET VALMBCK=""
- QUIT
- +1 KILL DIR,DIRUT,DTOUT,PSOOELSE,PSOREPX
- IF '+LST
- DO KILL
- SET VALMBCK=""
- QUIT
- +2 SET PSOOELSE=1
- DO FULL^VALM1
- +3 SET PPL=""
- FOR ORD=1:1:$LENGTH(LST,",")
- if $PIECE(LST,",",ORD)']""
- QUIT
- Begin DoDot:1
- +4 SET ORN=$PIECE(LST,",",ORD)
- SET PSOIEN=$PIECE(PSOLST(ORN),"^",2)
- IF $PIECE(PSOLST(ORN),"^",3)'="PENDING"
- Begin DoDot:2
- +5 ;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
- +6 NEW PSOQUIT
- +7 SET PSOSTA=$PIECE($GET(^PSRX(PSOIEN,"STA")),"^")
- Begin DoDot:3
- +8 SET PSOQUIT=1
- +9 IF PSOSTA'=0
- IF PSOSTA'=5
- WRITE !!,$PIECE(^PSRX(PSOIEN,0),"^")," is not active or suspended"
- HANG 2
- QUIT
- +10 ;#441 PAPI
- IF $DATA(^PSRX(PSOIEN,"PARK"))
- WRITE !!,$PIECE(^PSRX(PSOIEN,0),"^")," is not active or suspended. Prescription must be unparked to be filled."
- HANG 2
- QUIT
- +11 SET PSOQUIT=0
- End DoDot:3
- if PSOQUIT
- QUIT
- +12 IF $PIECE($GET(^PSRX(PSOIEN,0)),"^",2)
- SET PPL=$SELECT(PPL:PPL_",",1:"")_PSOIEN
- +13 SET VALMBCK="R"
- End DoDot:2
- End DoDot:1
- +14 IF +PPL
- SET SAVEPPL=PPL
- FOR II=1:1
- SET PSOIEN=$PIECE(SAVEPPL,",",II)
- if PSOIEN=""
- QUIT
- Begin DoDot:1
- +15 DO SENDRX
- +16 IF $GET(PPL)]""
- WRITE !!,$PIECE(^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...",!
- HANG 2
- End DoDot:1
- +17 IF '$GET(PSOOELSE)
- SET VALMBCK=""
- +18 ;PSO*7.0*462
- DO ^PSOBUILD
- KILL SAVEPPL
- +19 DO KILL
- DO KVA^VADPT
- +20 QUIT
- +21 ;
- KILL ; CLEAN UP VARIABLES
- +1 KILL DIC,LST,ORD,ORN,PSOIEN,PNM,PPL,PSZIP,RX,SSNP,VA,VADDR1,VADM,VAEL,VAPA,VASTREET
- +2 IF $GET(SAVEPPL)
- SET PPL=SAVEPPL
- KILL SAVEPPL
- +3 QUIT
- +4 ;
- SENDRX ; SET RX INTO SUSPENSE FILE FOR CMOP
- +1 NEW LAST,I,TRX,PSOMC,PSOMDT
- +2 SET LAST=0
- IF $DATA(^PSRX(PSOIEN,1))
- SET I=0
- FOR
- SET I=$ORDER(^PSRX(PSOIEN,1,I))
- if 'I
- QUIT
- SET LAST=I
- +3 IF $DATA(PSOSITE)
- SET PSXSITEA=PSOSITE
- +4 SET PSOSITE=$SELECT(LAST=0:$PIECE(^PSRX(PSOIEN,2),"^",9),1:$PIECE(^PSRX(PSOIEN,1,LAST,0),"^",9))
- +5 DO NOW^%DTC
- +6 NEW ZD
- +7 SET PPL=PSOIEN
- +8 SET TRX=$PIECE($GET(PPL),",",1)
- +9 SET DFN=$PIECE(^PSRX(TRX,0),"^",2)
- SET PSOMDT=$PIECE($GET(^PS(55,DFN,0)),"^",5)
- SET PSOMC=$PIECE($GET(^PS(55,DFN,0)),"^",3)
- KILL DFN,TRX
- +10 ;p753
- IF $$GET1^DIQ(52,PSOIEN,100.2,"I")]""
- SET PSOMC=$$GET1^DIQ(52,PSOIEN,100.2,"I")
- SET PSOMDT=""
- +11 IF (PSOMC>1&(PSOMDT>DT))!(PSOMC>1&(PSOMDT<1))
- WRITE !,"Cannot suspend for CMOP. Patient's mail status not a CMOP mail status"
- HANG 2
- KILL PPL
- QUIT
- +12 SET ZD(PSOIEN)=%
- DO TEST^PSOCMOP
- HANG 2
- +13 IF $GET(PSXSITEA)]""
- SET PSOSITE=PSXSITEA
- +14 QUIT
- +15 ;