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

PSONDCV.m

Go to the documentation of this file.
  1. PSONDCV ;BP/CMF - Pharmacy NDC Validation ;04/08/08
  1. ;;7.0;OUTPATIENT PHARMACY;**289,385**;DEC 1997;Build 27
  1. ;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
  1. ;Reference to $$STATUS^BPSOSRX suppored by DBIA 4300
  1. ;
  1. Q
  1. ;
  1. EN ; entry point for [PSO NDC VALIDATION] option
  1. N FLAG,PSOINST
  1. S FLAG=0
  1. D BEGIN(.FLAG)
  1. D:FLAG PROMPTS
  1. D END
  1. Q
  1. ;;
  1. BEGIN(RESULT) ;;
  1. I '$D(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"A Pharmacy Division Must Be Selected!",! G END
  1. S RESULT=$$ECMEON^BPSUTIL(PSOSITE)
  1. S PSOINST=$$GET1^DIQ(59,PSOSITE,".06")
  1. D:RESULT=0
  1. .W !!,"ePharmacy has not been activated for "_$$GET1^DIQ(59,PSOSITE,".01")_"("_PSOSITE_")."
  1. .W !,"NDC validation not allowed."
  1. Q
  1. ;;
  1. END ;;
  1. ;;D KILL^XUSCLEAN
  1. Q
  1. ;;
  1. PROMPTS ;;
  1. N X,Y,DIC,RXIEN,RX,PSORESP,QFLG,RXNUM,PSOMSG,PSONDCV,CMOP,PID
  1. S (PSONDCV("QFLG"),PSORESP)=0
  1. F Q:PSORESP=-1!(PSONDCV("QFLG")) D
  1. .W !
  1. .K DIR,RX,RXIEN
  1. .S DIR(0)="FO^1:245^"
  1. .S DIR("A")="WAND BARCODE or enter Rx#"
  1. .S DIR("?",1)="Wand barcodes should be of the form NNN-NNNNNN"
  1. .S DIR("?",2)="where the number before the dash is your station number."
  1. .S DIR("?",3)="The fill number used for NDC Validation is defaulted to"
  1. .S DIR("?",4)="the last fill for the prescription number entered."
  1. .S DIR("?")="Enter ""^"", or a RETURN to quit."
  1. .D ^DIR Q:PSONDCV("QFLG")
  1. .I $D(DIRUT) S PSONDCV("QFLG")=1 K DIRUT,DUOUT,DTOUT,DIROUT Q
  1. .;
  1. . I X["-" S QFLG=0 D Q:QFLG
  1. .. I $P(X,"-")'=PSOINST W !?7,$C(7),$C(7),$C(7),"Not From this Institution" S QFLG=1 Q
  1. .. S RXIEN=$P(X,"-",2)
  1. .. I $G(^PSRX(RXIEN,0))']"" W !,$C(7),"Rx data is not on file !",! S QFLG=1 Q
  1. .. S RX=$P(^PSRX(RXIEN,0),"^",1)
  1. . I X'["-" S RX=X K DIC S DIC=52,DIC(0)="BXQ",X=RX D ^DIC D Q:Y=-1
  1. .. I Y=-1 W !!,"Invalid prescription number.",! Q
  1. .. S RXIEN=$P(Y,"^"),RX=$P(Y,"^",2)
  1. . D PSOL^PSSLOCK(RXIEN) I '$G(PSOMSG) D K PSOMSG S QFLG=1 Q
  1. .. W $C(7),!!?5,"Another person is editing Rx "_$P($G(^PSRX(+$G(RXIEN),0)),"^"),!
  1. .;
  1. .D VALIDATE(RX,RXIEN)
  1. .D PSOUL^PSSLOCK(RXIEN)
  1. Q
  1. ;;
  1. VALIDATE(RX,RXIEN) ;;
  1. N DIR,X,Y,ISVALID,FLAG,RFL,RXDIV,LBL,LPRT,ESTAT,LABELNDC,STOCKNDC,RXNDC,STOCK
  1. S FLAG=0,LPRT=0
  1. S RFL=$$LSTRFL^PSOBPSU1(RXIEN)
  1. ;
  1. S RXDIV=$$RXSITE^PSOBPSUT(RXIEN,RFL) I RXDIV'=PSOSITE D Q
  1. . W !,"Prescription #"_RX_" is from a different division: "_$$GET1^DIQ(59,RXDIV,".01")_"."
  1. . W !,"Log into that division for NDC validation.",!!
  1. ;
  1. S ISVALID=$$ISVALID(RXIEN,RFL,0)
  1. I ISVALID D Q:FLAG
  1. .W !!,"Prescription "_RX_" has already been validated."
  1. .S DIR("A")="Are you sure you want to revalidate"
  1. .S DIR(0)="Y"
  1. .S DIR("B")="YES"
  1. .D ^DIR
  1. .S:Y'=1 FLAG=1
  1. I $$ISOPAI(RX,RFL) D Q ;can't validate RXs sent to external interface
  1. .W !!,"Prescription "_RX_" has been sent to the external interface."
  1. .W !,"It cannot be validated at this time."
  1. I $$ISRELEAS(RXIEN,RFL) D Q ;can't validate released RXs
  1. .W !!,"Prescription "_RX_" has been released."
  1. .W !,"It cannot be validated at this time."
  1. I $$ISCMOP(RXIEN,RFL) D Q ;can't validate RXs sent to CMOP
  1. .W !!,"Prescription "_RX_" is a CMOP Rx."
  1. .W !,"CMOP RXs may not be validated."
  1. S FLAG=0 D ELIG(.FLAG,RXIEN,RFL)
  1. I FLAG=1 Q
  1. 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
  1. I 'LPRT W !!,"The prescription label must be printed prior to the NDC being validated.",!! Q
  1. D DISPLAY(RX,RXIEN,RFL,.RXNDC)
  1. S LABELNDC=RXNDC
  1. S STOCK=1
  1. S FLAG=$$CHGNDC^PSONDCUT(RXIEN,RFL,$G(PID),STOCK) I FLAG="^" S FLAG=1 W !!,"** Validation not completed.",!! Q
  1. S STOCKNDC=$P(FLAG,"^",2),FLAG=+FLAG
  1. I FLAG S LABELNDC=$$GETNDC^PSONDCUT(RXIEN,RFL) ;ndc changed
  1. S ESTAT=$$STATUS^BPSOSRX(RXIEN,RFL)
  1. I $P(ESTAT,"^")["PAYABLE",(LABELNDC=STOCKNDC!(STOCKNDC=""&('FLAG))) D ;FLAG=0 NDC not changed; flag=1 ndc changed.
  1. .W !!,"NDC match confirmed.",!
  1. .S FLAG=1 D UPDATE(RXIEN,RFL)
  1. E D
  1. . D DEL(RXIEN,RFL)
  1. . W !!,"NDC validation has not been completed. " W:$P(ESTAT,"^")'="" "Rx claim was "_$P(ESTAT,"^"),! Q
  1. Q
  1. ;;
  1. ISVALID(RXIEN,RFL,VERBOSE) ;;
  1. Q:RFL=0 $$ISRXVAL(RXIEN,VERBOSE)
  1. Q $$ISRFLVAL(RXIEN,RFL,VERBOSE)
  1. ;
  1. ISRXVAL(RXIEN,VERBOSE) ;are NDCs already validated for Rx?
  1. N IENS,VALIDATE,VALIDUZ,RESULT
  1. S RESULT=0
  1. S IENS=RXIEN_","
  1. S VALIDATE=$$GET1^DIQ(52,IENS,83)
  1. S VALIDUZ=$$GET1^DIQ(52,IENS,84)
  1. I VALIDATE'="",VALIDUZ'="" S RESULT=1
  1. D DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ)
  1. Q RESULT
  1. ;;
  1. ISRFLVAL(RXIEN,RFL,VERBOSE) ;are NDCs already validated for refill?
  1. N IENS,VALIDATE,VALIDUZ,RESULT
  1. S RESULT=0
  1. S IENS=RFL_","_RXIEN_","
  1. S VALIDATE=$$GET1^DIQ(52.1,IENS,83)
  1. S VALIDUZ=$$GET1^DIQ(52.1,IENS,84)
  1. I VALIDATE'="",VALIDUZ'="" S RESULT=1
  1. D DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ)
  1. Q RESULT
  1. ;;
  1. ISOPAI(RX,RFL) ;;
  1. N RESULT,II,OPIAIEN,OPIAIEN,OPIARX
  1. D FIND^DIC(52.51,"",".01;9","",RX,"","","","","RESULT")
  1. S OPIARX=0
  1. I $D(RESULT("DILIST","ID")) S II=0 F S II=$O(RESULT("DILIST","ID",II)) Q:II="" D
  1. . I $D(RESULT("DILIST","ID",II,9)) S:RESULT("DILIST","ID",II,9)=RFL OPIARX=1
  1. Q OPIARX
  1. ;;
  1. ISRELEAS(RXIEN,RFL) ;; has it been released?
  1. N RESULT
  1. S RESULT=0
  1. I $$RXRLDT^PSOBPSUT(RXIEN,RFL)'="" S RESULT=1
  1. Q RESULT
  1. ;;
  1. ISCMOP(RXIEN,RFL) ;; has it been sent to CMOP?
  1. Q $$CMOP^PSOBPSUT(RXIEN,RFL)
  1. ;;
  1. DISPLAY(RX,RXIEN,RFL,RXNDC) ;;
  1. N OUT
  1. W !
  1. S OUT=$$LJ^XLFSTR("Rx: "_RX,20)
  1. S OUT=OUT_$$LJ^XLFSTR("Fill: "_RFL,20)
  1. S OUT=OUT_$$LJ^XLFSTR("Patient: "_$$GET1^DIQ(52,RXIEN,2),38)
  1. W !,OUT
  1. S OUT=$$LJ^XLFSTR("Drug: "_$$GET1^DIQ(52,RXIEN,6),40)
  1. S RXNDC=$S(+RFL:$$GET1^DIQ(52.1,RFL_","_RXIEN,11),1:$$GET1^DIQ(52,RXIEN,27))
  1. S OUT=OUT_$$LJ^XLFSTR("NDC: "_RXNDC,38)
  1. W !,OUT,!
  1. Q
  1. ;;
  1. DISPLAY1(VERBOSE,RESULT,VALIDATE,VALIDUZ) ;;
  1. Q:VERBOSE=0
  1. I RESULT=1 D Q
  1. . W !,"** The following NDC was validated on "_VALIDATE_" by "_VALIDUZ_".",!
  1. W !,"** This NDC has not been validated.",!!
  1. Q
  1. ;;
  1. UPDATE(RXIEN,RFL) ; update validation fields
  1. N IENS,FILE,FDA,ERROR
  1. I $G(RFL)>0 D
  1. .S IENS=RFL_","_RXIEN_","
  1. .S FILE=52.1
  1. E D
  1. .S IENS=RXIEN_","
  1. .S FILE=52
  1. S FDA(FILE,IENS,83)=$$NOW^XLFDT()
  1. S FDA(FILE,IENS,84)=DUZ
  1. D FILE^DIE("","FDA","ERROR")
  1. Q
  1. ;;
  1. DEL(RXIEN,RFL) ; update validation fields
  1. N IENS,FILE,FDA,ERROR
  1. I $G(RFL)>0 D
  1. .S IENS=RFL_","_RXIEN_","
  1. .S FILE=52.1
  1. E D
  1. .S IENS=RXIEN_","
  1. .S FILE=52
  1. S FDA(FILE,IENS,83)="@"
  1. S FDA(FILE,IENS,84)="@"
  1. D FILE^DIE("","FDA","ERROR")
  1. Q
  1. ;;
  1. ELIG(FLAG,RXIEN,RFL) ;TRICARE/CHAMPVA test #1
  1. N PSOTRIC
  1. D:$$TRIC^PSOREJP1(RXIEN,RFL,.PSOTRIC)
  1. .D:$$STATUS^PSOBPSUT(RXIEN,RFL)'="E PAYABLE"
  1. ..S FLAG=1
  1. ..W !,"This prescription fill has open "_$$ELIGDISP^PSOREJP1(RXIEN,RFL)_" third party insurance"
  1. ..W !,"rejections that must be resolved prior to completion of NDC validation."
  1. Q
  1. ;;