PSONDCV ;BP/CMF - Pharmacy NDC Validation ;29-May-2012 14:55;PLS
;;7.0;OUTPATIENT PHARMACY;**289,1015**;DEC 1997;Build 62
;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
;Reference to $$STATUS^BPSOSRX suppored by DBIA 4300
;
;Modified - IHS/MSC/PLS - 05/26/2010 - Lin VALIDATE+33
Q
;
EN ; entry point for [PSO NDC VALIDATION] option
N FLAG,PSOINST
S FLAG=0
D BEGIN(.FLAG)
D:FLAG PROMPTS
D END
Q
;;
BEGIN(RESULT) ;;
I '$D(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"A Pharmacy Division Must Be Selected!",! G END
S RESULT=$$ECMEON^BPSUTIL(PSOSITE)
S PSOINST=$$GET1^DIQ(59,PSOSITE,".06")
D:RESULT=0
.W !!,"ePharmacy has not been activated for "_$$GET1^DIQ(59,PSOSITE,".01")_"("_PSOSITE_")."
.W !,"NDC validation not allowed."
Q
;;
END ;;
;;D KILL^XUSCLEAN
Q
;;
PROMPTS ;;
N X,Y,DIC,RXIEN,RX,PSORESP,QFLG,RXNUM,PSOMSG,PSONDCV,CMOP,PID
S (PSONDCV("QFLG"),PSORESP)=0
F Q:PSORESP=-1!(PSONDCV("QFLG")) D
.W !
.K DIR,RX,RXIEN
.S DIR(0)="FO^1:245^"
.S DIR("A")="WAND BARCODE or enter Rx#"
.S DIR("?",1)="Wand barcodes should be of the form NNN-NNNNNN"
.S DIR("?",2)="where the number before the dash is your station number."
.S DIR("?",3)="The fill number used for NDC Validation is defaulted to"
.S DIR("?",4)="the last fill for the prescription number entered."
.S DIR("?")="Enter ""^"", or a RETURN to quit."
.D ^DIR Q:PSONDCV("QFLG")
.I $D(DIRUT) S PSONDCV("QFLG")=1 K DIRUT,DUOUT,DTOUT,DIROUT Q
.;
. I X["-" S QFLG=0 D Q:QFLG
.. I $P(X,"-")'=PSOINST W !?7,$C(7),$C(7),$C(7),"Not From this Institution" S QFLG=1 Q
.. S RXIEN=$P(X,"-",2)
.. I $G(^PSRX(RXIEN,0))']"" W !,$C(7),"Rx data is not on file !",! S QFLG=1 Q
.. S RX=$P(^PSRX(RXIEN,0),"^",1)
. I X'["-" S RX=X K DIC S DIC=52,DIC(0)="BXQ",X=RX D ^DIC D Q:Y=-1
.. I Y=-1 W !!,"Invalid prescription number.",! Q
.. S RXIEN=$P(Y,"^"),RX=$P(Y,"^",2)
. D PSOL^PSSLOCK(RXIEN) I '$G(PSOMSG) D K PSOMSG S QFLG=1 Q
.. W $C(7),!!?5,"Another person is editing Rx "_$P($G(^PSRX(+$G(RXIEN),0)),"^"),!
.;
.D VALIDATE(RX,RXIEN)
.D PSOUL^PSSLOCK(RXIEN)
Q
;;
VALIDATE(RX,RXIEN) ;;
N DIR,X,Y,ISVALID,FLAG,RFL,RXDIV,LBL,LPRT,ESTAT,LABELNDC,STOCKNDC,RXNDC,STOCK
S FLAG=0,LPRT=0
S RFL=$$LSTRFL^PSOBPSU1(RXIEN)
;
S RXDIV=$$RXSITE^PSOBPSUT(RXIEN,RFL) I RXDIV'=PSOSITE D Q
. W !,"Prescription #"_RX_" is from a different division: "_$$GET1^DIQ(59,RXDIV,".01")_"."
. W !,"Log into that division for NDC validation.",!!
;
S ISVALID=$$ISVALID(RXIEN,RFL,0)
I ISVALID D Q:FLAG
.W !!,"Prescription "_RX_" has already been validated."
.S DIR("A")="Are you sure you want to revalidate"
.S DIR(0)="Y"
.S DIR("B")="YES"
.D ^DIR
.S:Y'=1 FLAG=1
I $$ISOPAI(RX,RFL) D Q ;can't validate RXs sent to external interface
.W !!,"Prescription "_RX_" has been sent to the external interface."
.W !,"It cannot be validated at this time."
I $$ISRELEAS(RXIEN,RFL) D Q ;can't validate released RXs
.W !!,"Prescription "_RX_" has been released."
.W !,"It cannot be validated at this time."
I $$ISCMOP(RXIEN,RFL) D Q ;can't validate RXs sent to CMOP
.W !!,"Prescription "_RX_" is a CMOP Rx."
.W !,"CMOP RXs may not be validated."
S FLAG=0 D TRICARE1(.FLAG,RXIEN,RFL)
I FLAG=1 Q
F LBL=0:0 S LBL=$O(^PSRX(RXIEN,"L",LBL)) Q:'LBL I +$P(^PSRX(RXIEN,"L",LBL,0),"^",2)=RFL S LPRT=1
I 'LPRT W !!,"The prescription label must be printed prior to the NDC being validated.",!! Q
D DISPLAY(RX,RXIEN,RFL,.RXNDC)
S LABELNDC=RXNDC
S STOCK=1
Q ;IHS/MSC/PLS - 05/26/2010
S FLAG=$$CHGNDC^PSONDCUT(RXIEN,RFL,$G(PID),STOCK) I FLAG="^" S FLAG=1 W !!,"** Validation not completed.",!! Q
S STOCKNDC=$P(FLAG,"^",2),FLAG=+FLAG
I FLAG S LABELNDC=$$GETNDC^PSONDCUT(RXIEN,RFL) ;ndc changed
S ESTAT=$$STATUS^BPSOSRX(RXIEN,RFL)
I $P(ESTAT,"^")["PAYABLE",(LABELNDC=STOCKNDC!(STOCKNDC=""&('FLAG))) D ;FLAG=0 NDC not changed; flag=1 ndc changed.
.W !!,"NDC match confirmed.",!
.S FLAG=1 D UPDATE(RXIEN,RFL)
E D
. D DEL(RXIEN,RFL)
. W !!,"NDC validation has not been completed. " W:$P(ESTAT,"^")'="" "Rx claim was "_$P(ESTAT,"^"),! Q
Q
;;
ISVALID(RXIEN,RFL,VERBOSE) ;;
Q:RFL=0 $$ISRXVAL(RXIEN,VERBOSE)
Q $$ISRFLVAL(RXIEN,RFL,VERBOSE)
;
ISRXVAL(RXIEN,VERBOSE) ;are NDCs already validated for Rx?
N IENS,VALIDATE,VALIDUZ,RESULT
S RESULT=0
S IENS=RXIEN_","
S VALIDATE=$$GET1^DIQ(52,IENS,83)
S VALIDUZ=$$GET1^DIQ(52,IENS,84)
I VALIDATE'="",VALIDUZ'="" S RESULT=1
D DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ)
Q RESULT
;;
ISRFLVAL(RXIEN,RFL,VERBOSE) ;are NDCs already validated for refill?
N IENS,VALIDATE,VALIDUZ,RESULT
S RESULT=0
S IENS=RFL_","_RXIEN_","
S VALIDATE=$$GET1^DIQ(52.1,IENS,83)
S VALIDUZ=$$GET1^DIQ(52.1,IENS,84)
I VALIDATE'="",VALIDUZ'="" S RESULT=1
D DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ)
Q RESULT
;;
ISOPAI(RX,RFL) ;;
N RESULT,II,OPIAIEN,OPIAIEN,OPIARX
D FIND^DIC(52.51,"",".01;9","",RX,"","","","","RESULT")
S OPIARX=0
I $D(RESULT("DILIST","ID")) S II=0 F S II=$O(RESULT("DILIST","ID",II)) Q:II="" D
. I $D(RESULT("DILIST","ID",II,9)) S:RESULT("DILIST","ID",II,9)=RFL OPIARX=1
Q OPIARX
;;
ISRELEAS(RXIEN,RFL) ;; has it been released?
N RESULT
S RESULT=0
I $$RXRLDT^PSOBPSUT(RXIEN,RFL)'="" S RESULT=1
Q RESULT
;;
ISCMOP(RXIEN,RFL) ;; has it been sent to CMOP?
Q $$CMOP^PSOBPSUT(RXIEN,RFL)
;;
DISPLAY(RX,RXIEN,RFL,RXNDC) ;;
N OUT
W !
S OUT=$$LJ^XLFSTR("Rx: "_RX,20)
S OUT=OUT_$$LJ^XLFSTR("Fill: "_RFL,20)
S OUT=OUT_$$LJ^XLFSTR("Patient: "_$$GET1^DIQ(52,RXIEN,2),38)
W !,OUT
S OUT=$$LJ^XLFSTR("Drug: "_$$GET1^DIQ(52,RXIEN,6),40)
S RXNDC=$S(+RFL:$$GET1^DIQ(52.1,RFL_","_RXIEN,11),1:$$GET1^DIQ(52,RXIEN,27))
S OUT=OUT_$$LJ^XLFSTR("NDC: "_RXNDC,38)
W !,OUT,!
Q
;;
DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ) ;;
Q:VERBOSE=0
I RESULT=1 D Q
. W !,"** The following NDC was validated on "_VALIDATE_" by "_VALIDUZ_".",!
W !,"** This NDC has not been validated.",!!
Q
;;
UPDATE(RXIEN,RFL) ; update validation fields
N IENS,FILE,FDA,ERROR
I $G(RFL)>0 D
.S IENS=RFL_","_RXIEN_","
.S FILE=52.1
E D
.S IENS=RXIEN_","
.S FILE=52
S FDA(FILE,IENS,83)=$$NOW^XLFDT()
S FDA(FILE,IENS,84)=DUZ
D FILE^DIE("","FDA","ERROR")
Q
;;
DEL(RXIEN,RFL) ; update validation fields
N IENS,FILE,FDA,ERROR
I $G(RFL)>0 D
.S IENS=RFL_","_RXIEN_","
.S FILE=52.1
E D
.S IENS=RXIEN_","
.S FILE=52
S FDA(FILE,IENS,83)="@"
S FDA(FILE,IENS,84)="@"
D FILE^DIE("","FDA","ERROR")
Q
;;
TRICARE1(FLAG,RXIEN,RFL) ; tricare test #1
N PSOTRIC
D:$$TRIC^PSOREJP1(RXIEN,RFL,.PSOTRIC)
.D:$$STATUS^PSOBPSUT(RXIEN,RFL)'="E PAYABLE"
..S FLAG=1
..W !,"This prescription fill has open Tricare third party insurance"
..W !,"rejections that must be resolved prior to completion of NDC validation."
Q
;;
PSONDCV ;BP/CMF - Pharmacy NDC Validation ;29-May-2012 14:55;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**289,1015**;DEC 1997;Build 62
+2 ;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
+3 ;Reference to $$STATUS^BPSOSRX suppored by DBIA 4300
+4 ;
+5 ;Modified - IHS/MSC/PLS - 05/26/2010 - Lin VALIDATE+33
+6 QUIT
+7 ;
EN ; entry point for [PSO NDC VALIDATION] option
+1 NEW FLAG,PSOINST
+2 SET FLAG=0
+3 DO BEGIN(.FLAG)
+4 IF FLAG
DO PROMPTS
+5 DO END
+6 QUIT
+7 ;;
BEGIN(RESULT) ;;
+1 IF '$DATA(PSOSITE)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"A Pharmacy Division Must Be Selected!",!
GOTO END
+2 SET RESULT=$$ECMEON^BPSUTIL(PSOSITE)
+3 SET PSOINST=$$GET1^DIQ(59,PSOSITE,".06")
+4 IF RESULT=0
Begin DoDot:1
+5 WRITE !!,"ePharmacy has not been activated for "_$$GET1^DIQ(59,PSOSITE,".01")_"("_PSOSITE_")."
+6 WRITE !,"NDC validation not allowed."
End DoDot:1
+7 QUIT
+8 ;;
END ;;
+1 ;;D KILL^XUSCLEAN
+2 QUIT
+3 ;;
PROMPTS ;;
+1 NEW X,Y,DIC,RXIEN,RX,PSORESP,QFLG,RXNUM,PSOMSG,PSONDCV,CMOP,PID
+2 SET (PSONDCV("QFLG"),PSORESP)=0
+3 FOR
IF PSORESP=-1!(PSONDCV("QFLG"))
QUIT
Begin DoDot:1
+4 WRITE !
+5 KILL DIR,RX,RXIEN
+6 SET DIR(0)="FO^1:245^"
+7 SET DIR("A")="WAND BARCODE or enter Rx#"
+8 SET DIR("?",1)="Wand barcodes should be of the form NNN-NNNNNN"
+9 SET DIR("?",2)="where the number before the dash is your station number."
+10 SET DIR("?",3)="The fill number used for NDC Validation is defaulted to"
+11 SET DIR("?",4)="the last fill for the prescription number entered."
+12 SET DIR("?")="Enter ""^"", or a RETURN to quit."
+13 DO ^DIR
IF PSONDCV("QFLG")
QUIT
+14 IF $DATA(DIRUT)
SET PSONDCV("QFLG")=1
KILL DIRUT,DUOUT,DTOUT,DIROUT
QUIT
+15 ;
+16 IF X["-"
SET QFLG=0
Begin DoDot:2
+17 IF $PIECE(X,"-")'=PSOINST
WRITE !?7,$CHAR(7),$CHAR(7),$CHAR(7),"Not From this Institution"
SET QFLG=1
QUIT
+18 SET RXIEN=$PIECE(X,"-",2)
+19 IF $GET(^PSRX(RXIEN,0))']""
WRITE !,$CHAR(7),"Rx data is not on file !",!
SET QFLG=1
QUIT
+20 SET RX=$PIECE(^PSRX(RXIEN,0),"^",1)
End DoDot:2
IF QFLG
QUIT
+21 IF X'["-"
SET RX=X
KILL DIC
SET DIC=52
SET DIC(0)="BXQ"
SET X=RX
DO ^DIC
Begin DoDot:2
+22 IF Y=-1
WRITE !!,"Invalid prescription number.",!
QUIT
+23 SET RXIEN=$PIECE(Y,"^")
SET RX=$PIECE(Y,"^",2)
End DoDot:2
IF Y=-1
QUIT
+24 DO PSOL^PSSLOCK(RXIEN)
IF '$GET(PSOMSG)
Begin DoDot:2
+25 WRITE $CHAR(7),!!?5,"Another person is editing Rx "_$PIECE($GET(^PSRX(+$GET(RXIEN),0)),"^"),!
End DoDot:2
KILL PSOMSG
SET QFLG=1
QUIT
+26 ;
+27 DO VALIDATE(RX,RXIEN)
+28 DO PSOUL^PSSLOCK(RXIEN)
End DoDot:1
+29 QUIT
+30 ;;
VALIDATE(RX,RXIEN) ;;
+1 NEW DIR,X,Y,ISVALID,FLAG,RFL,RXDIV,LBL,LPRT,ESTAT,LABELNDC,STOCKNDC,RXNDC,STOCK
+2 SET FLAG=0
SET LPRT=0
+3 SET RFL=$$LSTRFL^PSOBPSU1(RXIEN)
+4 ;
+5 SET RXDIV=$$RXSITE^PSOBPSUT(RXIEN,RFL)
IF RXDIV'=PSOSITE
Begin DoDot:1
+6 WRITE !,"Prescription #"_RX_" is from a different division: "_$$GET1^DIQ(59,RXDIV,".01")_"."
+7 WRITE !,"Log into that division for NDC validation.",!!
End DoDot:1
QUIT
+8 ;
+9 SET ISVALID=$$ISVALID(RXIEN,RFL,0)
+10 IF ISVALID
Begin DoDot:1
+11 WRITE !!,"Prescription "_RX_" has already been validated."
+12 SET DIR("A")="Are you sure you want to revalidate"
+13 SET DIR(0)="Y"
+14 SET DIR("B")="YES"
+15 DO ^DIR
+16 IF Y'=1
SET FLAG=1
End DoDot:1
IF FLAG
QUIT
+17 ;can't validate RXs sent to external interface
IF $$ISOPAI(RX,RFL)
Begin DoDot:1
+18 WRITE !!,"Prescription "_RX_" has been sent to the external interface."
+19 WRITE !,"It cannot be validated at this time."
End DoDot:1
QUIT
+20 ;can't validate released RXs
IF $$ISRELEAS(RXIEN,RFL)
Begin DoDot:1
+21 WRITE !!,"Prescription "_RX_" has been released."
+22 WRITE !,"It cannot be validated at this time."
End DoDot:1
QUIT
+23 ;can't validate RXs sent to CMOP
IF $$ISCMOP(RXIEN,RFL)
Begin DoDot:1
+24 WRITE !!,"Prescription "_RX_" is a CMOP Rx."
+25 WRITE !,"CMOP RXs may not be validated."
End DoDot:1
QUIT
+26 SET FLAG=0
DO TRICARE1(.FLAG,RXIEN,RFL)
+27 IF FLAG=1
QUIT
+28 FOR LBL=0:0
SET LBL=$ORDER(^PSRX(RXIEN,"L",LBL))
IF 'LBL
QUIT
IF +$PIECE(^PSRX(RXIEN,"L",LBL,0),"^",2)=RFL
SET LPRT=1
+29 IF 'LPRT
WRITE !!,"The prescription label must be printed prior to the NDC being validated.",!!
QUIT
+30 DO DISPLAY(RX,RXIEN,RFL,.RXNDC)
+31 SET LABELNDC=RXNDC
+32 SET STOCK=1
+33 ;IHS/MSC/PLS - 05/26/2010
QUIT
+34 SET FLAG=$$CHGNDC^PSONDCUT(RXIEN,RFL,$GET(PID),STOCK)
IF FLAG="^"
SET FLAG=1
WRITE !!,"** Validation not completed.",!!
QUIT
+35 SET STOCKNDC=$PIECE(FLAG,"^",2)
SET FLAG=+FLAG
+36 ;ndc changed
IF FLAG
SET LABELNDC=$$GETNDC^PSONDCUT(RXIEN,RFL)
+37 SET ESTAT=$$STATUS^BPSOSRX(RXIEN,RFL)
+38 ;FLAG=0 NDC not changed; flag=1 ndc changed.
IF $PIECE(ESTAT,"^")["PAYABLE"
IF (LABELNDC=STOCKNDC!(STOCKNDC=""&('FLAG)))
Begin DoDot:1
+39 WRITE !!,"NDC match confirmed.",!
+40 SET FLAG=1
DO UPDATE(RXIEN,RFL)
End DoDot:1
+41 IF '$TEST
Begin DoDot:1
+42 DO DEL(RXIEN,RFL)
+43 WRITE !!,"NDC validation has not been completed. "
IF $PIECE(ESTAT,"^")'=""
WRITE "Rx claim was "_$PIECE(ESTAT,"^"),!
QUIT
End DoDot:1
+44 QUIT
+45 ;;
ISVALID(RXIEN,RFL,VERBOSE) ;;
+1 IF RFL=0
QUIT $$ISRXVAL(RXIEN,VERBOSE)
+2 QUIT $$ISRFLVAL(RXIEN,RFL,VERBOSE)
+3 ;
ISRXVAL(RXIEN,VERBOSE) ;are NDCs already validated for Rx?
+1 NEW IENS,VALIDATE,VALIDUZ,RESULT
+2 SET RESULT=0
+3 SET IENS=RXIEN_","
+4 SET VALIDATE=$$GET1^DIQ(52,IENS,83)
+5 SET VALIDUZ=$$GET1^DIQ(52,IENS,84)
+6 IF VALIDATE'=""
IF VALIDUZ'=""
SET RESULT=1
+7 DO DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ)
+8 QUIT RESULT
+9 ;;
ISRFLVAL(RXIEN,RFL,VERBOSE) ;are NDCs already validated for refill?
+1 NEW IENS,VALIDATE,VALIDUZ,RESULT
+2 SET RESULT=0
+3 SET IENS=RFL_","_RXIEN_","
+4 SET VALIDATE=$$GET1^DIQ(52.1,IENS,83)
+5 SET VALIDUZ=$$GET1^DIQ(52.1,IENS,84)
+6 IF VALIDATE'=""
IF VALIDUZ'=""
SET RESULT=1
+7 DO DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ)
+8 QUIT RESULT
+9 ;;
ISOPAI(RX,RFL) ;;
+1 NEW RESULT,II,OPIAIEN,OPIAIEN,OPIARX
+2 DO FIND^DIC(52.51,"",".01;9","",RX,"","","","","RESULT")
+3 SET OPIARX=0
+4 IF $DATA(RESULT("DILIST","ID"))
SET II=0
FOR
SET II=$ORDER(RESULT("DILIST","ID",II))
IF II=""
QUIT
Begin DoDot:1
+5 IF $DATA(RESULT("DILIST","ID",II,9))
IF RESULT("DILIST","ID",II,9)=RFL
SET OPIARX=1
End DoDot:1
+6 QUIT OPIARX
+7 ;;
ISRELEAS(RXIEN,RFL) ;; has it been released?
+1 NEW RESULT
+2 SET RESULT=0
+3 IF $$RXRLDT^PSOBPSUT(RXIEN,RFL)'=""
SET RESULT=1
+4 QUIT RESULT
+5 ;;
ISCMOP(RXIEN,RFL) ;; has it been sent to CMOP?
+1 QUIT $$CMOP^PSOBPSUT(RXIEN,RFL)
+2 ;;
DISPLAY(RX,RXIEN,RFL,RXNDC) ;;
+1 NEW OUT
+2 WRITE !
+3 SET OUT=$$LJ^XLFSTR("Rx: "_RX,20)
+4 SET OUT=OUT_$$LJ^XLFSTR("Fill: "_RFL,20)
+5 SET OUT=OUT_$$LJ^XLFSTR("Patient: "_$$GET1^DIQ(52,RXIEN,2),38)
+6 WRITE !,OUT
+7 SET OUT=$$LJ^XLFSTR("Drug: "_$$GET1^DIQ(52,RXIEN,6),40)
+8 SET RXNDC=$SELECT(+RFL:$$GET1^DIQ(52.1,RFL_","_RXIEN,11),1:$$GET1^DIQ(52,RXIEN,27))
+9 SET OUT=OUT_$$LJ^XLFSTR("NDC: "_RXNDC,38)
+10 WRITE !,OUT,!
+11 QUIT
+12 ;;
DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ) ;;
+1 IF VERBOSE=0
QUIT
+2 IF RESULT=1
Begin DoDot:1
+3 WRITE !,"** The following NDC was validated on "_VALIDATE_" by "_VALIDUZ_".",!
End DoDot:1
QUIT
+4 WRITE !,"** This NDC has not been validated.",!!
+5 QUIT
+6 ;;
UPDATE(RXIEN,RFL) ; update validation fields
+1 NEW IENS,FILE,FDA,ERROR
+2 IF $GET(RFL)>0
Begin DoDot:1
+3 SET IENS=RFL_","_RXIEN_","
+4 SET FILE=52.1
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET IENS=RXIEN_","
+7 SET FILE=52
End DoDot:1
+8 SET FDA(FILE,IENS,83)=$$NOW^XLFDT()
+9 SET FDA(FILE,IENS,84)=DUZ
+10 DO FILE^DIE("","FDA","ERROR")
+11 QUIT
+12 ;;
DEL(RXIEN,RFL) ; update validation fields
+1 NEW IENS,FILE,FDA,ERROR
+2 IF $GET(RFL)>0
Begin DoDot:1
+3 SET IENS=RFL_","_RXIEN_","
+4 SET FILE=52.1
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET IENS=RXIEN_","
+7 SET FILE=52
End DoDot:1
+8 SET FDA(FILE,IENS,83)="@"
+9 SET FDA(FILE,IENS,84)="@"
+10 DO FILE^DIE("","FDA","ERROR")
+11 QUIT
+12 ;;
TRICARE1(FLAG,RXIEN,RFL) ; tricare test #1
+1 NEW PSOTRIC
+2 IF $$TRIC^PSOREJP1(RXIEN,RFL,.PSOTRIC)
Begin DoDot:1
+3 IF $$STATUS^PSOBPSUT(RXIEN,RFL)'="E PAYABLE"
Begin DoDot:2
+4 SET FLAG=1
+5 WRITE !,"This prescription fill has open Tricare third party insurance"
+6 WRITE !,"rejections that must be resolved prior to completion of NDC validation."
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;;
