- PSXRESUB ;BIR/HTW-Resubmit an Rx to the CMOP ;03/11/99 1:14 PM
- ;;2.0;CMOP;**3,20,21,41**;11 Apr 97
- ;Reference to ^PSRX (File #52) supported by DBIA #1977
- ;Reference to routine PSOCMOP supported by DBIA #2476
- I '$D(^XUSEC("PSXRESUB",DUZ)) W !,"You are not authorized to use this option." Q
- W !!,"CMOP Prescription Resubmission Utility",!!
- TOP S LAST=0
- S DIR(0)="FO^1:15",DIR("A")="Enter the Rx # to resubmit"
- S DIR("?")="Enter the prescription number you want to send back to the CMOP to be dispensed."
- D ^DIR K DIR I $D(DIRUT) G END
- S RX=Y K Y
- S I52=$O(^PSRX("B",RX,"")) I $G(I52)']"" W !,"Rx # "_RX_" either does not exist or is an invalid #." D END G PSXRESUB
- ; Check for CMOP nodes
- I '$D(^PSRX(I52,4)) W !,"There have been no CMOP transmissions for this Rx. You can not Resubmit it!",! D END G PSXRESUB
- ; Get last OP refill
- I $D(^PSRX(I52,1)) F I=0:0 S I=$O(^PSRX(I52,1,I)) Q:'I S RF=I
- ; Get last CMOP event entry marked as Not Dispensed
- F CT=0:0 S CT=$O(^PSRX(I52,4,CT)) Q:'CT D
- .S NODE=$G(^PSRX(I52,4,CT,0))
- .S CHECK=$P($G(NODE),"^",3) Q:$P($G(NODE),"^",4)'=3
- .; S PSX(FILL#)=RESUBMIT #
- .S PSX($P($G(NODE),"^",3))=$P($G(NODE),"^",6)_"^"_CT,LAST=$P($G(NODE),"^",3)
- ; If the last CMOP '= the last OP Quit
- I $G(RF)>$G(LAST) W !!,"This Rx cannot be resubmitted. A later fill has already been entered." D END G TOP
- I $G(CHECK)>$G(LAST) W !!,"This Rx cannot be resubmitted. A later fill has already been transmitted to the CMOP." D END G TOP
- I $P($G(^PSRX(I52,2)),"^",6)<DT W !!,"This prescription has expired. You cannot resubmit it." D END G TOP
- I $G(PSX(LAST))["Y" W !!,"This Rx has already been resubmitted the maximum allowable times. You cannot resubmit it." D END G TOP
- I $G(PSX(LAST))']"" W !!,"This Rx is not eligible for resubmission.",!,"The last fill must have a status of 'NOT DISPENSED'.",! D END G TOP
- I $G(PSX(LAST))=3,($G(^PSRX(I52,4,LAST,1))["DUPLICATE") W !!,"This Rx is not eligible for resubmission.",!,"The last fill has been returned as a duplicate.",! D END G TOP
- I LAST>0 I '$D(^PSRX(I52,1,LAST,0)) W !!,"This RX is not eligible for resubmission.",!,"The fill # "_LAST_" appears to have been canceled.",! D END G TOP ;*41
- W !!,"You have chosen Rx # "_RX_" to be resubmitted to the CMOP."
- S DIR("A")="Do you want to continue? ",DIR("B")="NO"
- S DIR(0)="SB^Y:YES;N:NO",DIR("?")="Enter Y if you want to send the selected prescription to the CMOP."
- D ^DIR K DIR I $D(DIRUT)!("Nn"[$E(Y)) D END G TOP
- I $G(PSOSITE)]"" S PSXSITEA=$G(PSOSITE)
- S PSOSITE=$S(LAST=0:$P(^PSRX(I52,2),"^",9),1:$P(^PSRX(I52,1,LAST,0),"^",9))
- D NOW^%DTC N ZD
- S PPL=I52,ZD(I52)=% D TEST^PSOCMOP
- I $G(PPL)']"" S $P(^PSRX(I52,4,$P(PSX(LAST),"^",2),0),"^",6)="Y"
- I $G(PPL)]"" W !!,"This is not a CMOP Rx. Make sure the last fill has a Mail routing, the drug is marked for CMOP, etc...",!!
- I $G(PSXSITEA)]"" S PSOSITE=PSXSITEA
- D END G TOP
- END K CHECK,CT,DIR,DIROUT,DIRUT,I52,LAST,NODE,PSX,PSXPPL,PPL,RF,RX,X,Y,ZD,%
- K PSXSITEA
- Q
- PSXRESUB ;BIR/HTW-Resubmit an Rx to the CMOP ;03/11/99 1:14 PM
- +1 ;;2.0;CMOP;**3,20,21,41**;11 Apr 97
- +2 ;Reference to ^PSRX (File #52) supported by DBIA #1977
- +3 ;Reference to routine PSOCMOP supported by DBIA #2476
- +4 IF '$DATA(^XUSEC("PSXRESUB",DUZ))
- WRITE !,"You are not authorized to use this option."
- QUIT
- +5 WRITE !!,"CMOP Prescription Resubmission Utility",!!
- TOP SET LAST=0
- +1 SET DIR(0)="FO^1:15"
- SET DIR("A")="Enter the Rx # to resubmit"
- +2 SET DIR("?")="Enter the prescription number you want to send back to the CMOP to be dispensed."
- +3 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO END
- +4 SET RX=Y
- KILL Y
- +5 SET I52=$ORDER(^PSRX("B",RX,""))
- IF $GET(I52)']""
- WRITE !,"Rx # "_RX_" either does not exist or is an invalid #."
- DO END
- GOTO PSXRESUB
- +6 ; Check for CMOP nodes
- +7 IF '$DATA(^PSRX(I52,4))
- WRITE !,"There have been no CMOP transmissions for this Rx. You can not Resubmit it!",!
- DO END
- GOTO PSXRESUB
- +8 ; Get last OP refill
- +9 IF $DATA(^PSRX(I52,1))
- FOR I=0:0
- SET I=$ORDER(^PSRX(I52,1,I))
- IF 'I
- QUIT
- SET RF=I
- +10 ; Get last CMOP event entry marked as Not Dispensed
- +11 FOR CT=0:0
- SET CT=$ORDER(^PSRX(I52,4,CT))
- IF 'CT
- QUIT
- Begin DoDot:1
- +12 SET NODE=$GET(^PSRX(I52,4,CT,0))
- +13 SET CHECK=$PIECE($GET(NODE),"^",3)
- IF $PIECE($GET(NODE),"^",4)'=3
- QUIT
- +14 ; S PSX(FILL#)=RESUBMIT #
- +15 SET PSX($PIECE($GET(NODE),"^",3))=$PIECE($GET(NODE),"^",6)_"^"_CT
- SET LAST=$PIECE($GET(NODE),"^",3)
- End DoDot:1
- +16 ; If the last CMOP '= the last OP Quit
- +17 IF $GET(RF)>$GET(LAST)
- WRITE !!,"This Rx cannot be resubmitted. A later fill has already been entered."
- DO END
- GOTO TOP
- +18 IF $GET(CHECK)>$GET(LAST)
- WRITE !!,"This Rx cannot be resubmitted. A later fill has already been transmitted to the CMOP."
- DO END
- GOTO TOP
- +19 IF $PIECE($GET(^PSRX(I52,2)),"^",6)<DT
- WRITE !!,"This prescription has expired. You cannot resubmit it."
- DO END
- GOTO TOP
- +20 IF $GET(PSX(LAST))["Y"
- WRITE !!,"This Rx has already been resubmitted the maximum allowable times. You cannot resubmit it."
- DO END
- GOTO TOP
- +21 IF $GET(PSX(LAST))']""
- WRITE !!,"This Rx is not eligible for resubmission.",!,"The last fill must have a status of 'NOT DISPENSED'.",!
- DO END
- GOTO TOP
- +22 IF $GET(PSX(LAST))=3
- IF ($GET(^PSRX(I52,4,LAST,1))["DUPLICATE")
- WRITE !!,"This Rx is not eligible for resubmission.",!,"The last fill has been returned as a duplicate.",!
- DO END
- GOTO TOP
- +23 ;*41
- IF LAST>0
- IF '$DATA(^PSRX(I52,1,LAST,0))
- WRITE !!,"This RX is not eligible for resubmission.",!,"The fill # "_LAST_" appears to have been canceled.",!
- DO END
- GOTO TOP
- +24 WRITE !!,"You have chosen Rx # "_RX_" to be resubmitted to the CMOP."
- +25 SET DIR("A")="Do you want to continue? "
- SET DIR("B")="NO"
- +26 SET DIR(0)="SB^Y:YES;N:NO"
- SET DIR("?")="Enter Y if you want to send the selected prescription to the CMOP."
- +27 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!("Nn"[$EXTRACT(Y))
- DO END
- GOTO TOP
- +28 IF $GET(PSOSITE)]""
- SET PSXSITEA=$GET(PSOSITE)
- +29 SET PSOSITE=$SELECT(LAST=0:$PIECE(^PSRX(I52,2),"^",9),1:$PIECE(^PSRX(I52,1,LAST,0),"^",9))
- +30 DO NOW^%DTC
- NEW ZD
- +31 SET PPL=I52
- SET ZD(I52)=%
- DO TEST^PSOCMOP
- +32 IF $GET(PPL)']""
- SET $PIECE(^PSRX(I52,4,$PIECE(PSX(LAST),"^",2),0),"^",6)="Y"
- +33 IF $GET(PPL)]""
- WRITE !!,"This is not a CMOP Rx. Make sure the last fill has a Mail routing, the drug is marked for CMOP, etc...",!!
- +34 IF $GET(PSXSITEA)]""
- SET PSOSITE=PSXSITEA
- +35 DO END
- GOTO TOP
- END KILL CHECK,CT,DIR,DIROUT,DIRUT,I52,LAST,NODE,PSX,PSXPPL,PPL,RF,RX,X,Y,ZD,%
- +1 KILL PSXSITEA
- +2 QUIT
