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

PSONDCUT.m

Go to the documentation of this file.
  1. PSONDCUT ;BIRM/MFR - NDC Utilities ;10/15/04
  1. ;;7.0;OUTPATIENT PHARMACY;**148,287,317,289,385,364**;DEC 1997;Build 15
  1. ;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
  1. ;References to $$GETNDC^PSSNDCUT,$$NDCFMT^PSSNDCUT,SAVNDC^PSSNDCUT supported by IA 4707
  1. ;
  1. CHGNDC(RX,RFL,BCODE,STOCK) ; Prompt for NDC code during Rx Release for HIPAA/NCPDP project
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill Number (#52.1)
  1. ; (o) BCODE - Displays PID: 999-99-9999/MED: XXXXX XXXXXXXXXXX 999MG in the NDC prompt (1-YES/0-NO)
  1. ; (o) STOCK - Flag denoting that Stock NDC is being Validated
  1. ;
  1. ;Output: (r) NDCCHG - NDC was changed? (1-YES/0-NO)^New NDC number
  1. ; OR "^" if no valid NDC or "^" entered
  1. ;
  1. N PSONDC,NEWNDC,SITE,NOREL,ACT,NDCVALID
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. S SITE=$$RXSITE^PSOBPSUT(RX,RFL) I '$$ECMEON^BPSUTIL(SITE) Q "^" ; ECME is not turned ON for the Rx's Division
  1. ;
  1. ; - Retrieving Rx NDC and Fill Date
  1. S PSONDC=$$GETNDC(RX,RFL),NOREL=0
  1. ;
  1. ; - Display NDC validation status
  1. S NDCVALID=$$ISVALID^PSONDCV(RX,RFL,1)
  1. ;
  1. ; - Prompts for NDC number
  1. I $G(BCODE) F I=1:1:5 W $C(7)
  1. S NEWNDC=PSONDC D NDCEDT(RX,RFL,,SITE,.NEWNDC,$G(BCODE)) I NEWNDC="^"!(NEWNDC="") Q "^"
  1. ;
  1. I '$D(PSOTRIC) N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
  1. ; - If NDC changed, resubmit to ECME and save new NDC in the DRUG and PRESCRIPTION files
  1. I PSONDC'=NEWNDC D Q:'NOREL ("1^"_NEWNDC) Q:NOREL 2
  1. . D RXACT^PSOBPSU2(RX,RFL,"NDC changed from "_PSONDC_" to "_NEWNDC_" during release.","E")
  1. . D SAVNDC(RX,RFL,NEWNDC,0,1)
  1. . N RESP D ECMESND^PSOBPSU1(RX,RFL,,"ED",NEWNDC,,"RX RELEASE-NDC CHANGE",,1,,1)
  1. . I $D(RESP),$P(RESP,"^",4)["IN PROGRESS",PSOTRIC S NOREL=1 Q
  1. . I '$D(RESP),$$STATUS^PSOBPSUT(RX,RFL)["IN PROGRESS",PSOTRIC D
  1. . . S NOREL=1,ACT=$$ELIGDISP^PSOREJP1(RX,RFL)_"-NDC edit at REL: Not released due to 'IN PROGRESS' ECME status"
  1. . . D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ)
  1. Q 0
  1. ;
  1. NDCEDT(RX,RFL,DRG,SITE,NDC,BCODE) ; Allows editing of the Rx NDC code
  1. ; Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill Number (#52.1)
  1. ; (o) DRG - Drug IEN (#50)
  1. ; (o) NDC - Default NDC Number/Return parameter ("" means no NDC selected) (Note: REQUIRED for Output value)
  1. ; (o) BCODE - Display the PID/Drug Name in the NDC prompt
  1. ;Output: (r) .NDC - Selected NDC Number
  1. ;
  1. N SNDC,SYN,Y,Z,IDX,I,PID,DFN,DRGNAM,PRPT,DIR,DEFNDC
  1. K ^TMP($J,"PSONDCDP"),^TMP($J,"PSONDCFM")
  1. I '$G(DRG),$G(RX) S DRG=$$GET1^DIQ(52,RX,6,"I")
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. S IDX=0,SITE=+$G(SITE) I 'SITE,$G(RX) S SITE=$$RXSITE^PSOBPSUT(RX,RFL)
  1. ;
  1. ; - Setting the NDC currently on the PRESCRIPTION (passed in)
  1. I $G(NDC)'="",$$NDCFMT^PSSNDCUT(NDC)'="" S IDX=1,^TMP($J,"PSONDCFM",IDX)=NDC,^TMP($J,"PSONDCDP",NDC)=IDX
  1. ;
  1. ; - Retrieving NDC from the PRESCRIPTION file
  1. I $G(RX) D
  1. . S NDC=$$GETNDC(RX,RFL)
  1. . I NDC'="",'$D(^TMP($J,"PSONDCDP",NDC)) D
  1. . . S IDX=IDX+1,^TMP($J,"PSONDCFM",IDX)=NDC,^TMP($J,"PSONDCDP",NDC)=IDX
  1. ;
  1. ; - Retrieve Price Per Dispense Unit for default NDC
  1. S DEFNDC="",DEFNDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50,DRG,31))
  1. ;
  1. S:'IDX IDX=1
  1. ;
  1. ; - Retrieving NDC from the DRUG/NDF files
  1. S NDC=$$GETNDC^PSSNDCUT(DRG)
  1. I NDC'="",'$D(^TMP($J,"PSONDCDP",NDC)) D
  1. . S IDX=IDX+1,^TMP($J,"PSONDCFM",IDX)=NDC,^TMP($J,"PSONDCDP",NDC)=IDX
  1. ;
  1. ; - Retrieving NDC by OUTPATIENT SITE from the DRUG/NDF files
  1. S NDC=$$GETNDC^PSSNDCUT(DRG,SITE)
  1. I NDC'="",'$D(^TMP($J,"PSONDCDP",NDC)) D
  1. . S IDX=IDX+1,^TMP($J,"PSONDCFM",IDX)=NDC,^TMP($J,"PSONDCDP",NDC)=IDX
  1. ;
  1. ; - Retrieving NDCs and price per dispense unit from SYNONYMS
  1. S SYN=0
  1. F S SYN=$O(^PSDRUG(DRG,1,SYN)) Q:SYN="" D
  1. . S Z=$G(^PSDRUG(DRG,1,SYN,0)),SNDC=$$NDCFMT^PSSNDCUT($P(Z,"^",2)) I SNDC="" Q
  1. . I $D(^TMP($J,"PSONDCDP",SNDC)) Q
  1. . S IDX=IDX+1,^TMP($J,"PSONDCFM",IDX)=SNDC
  1. . S ^TMP($J,"PSONDCDP",SNDC)=IDX
  1. ;
  1. I '$D(^TMP($J,"PSONDCFM")) D S NDC="^" G END
  1. . W !!,"No valid NDC codes found for "_$$GET1^DIQ(50,DRG,.01),$C(7)
  1. ;
  1. ASK ; Ask for NDC
  1. S PRPT="",DRGNAM=$E($$GET1^DIQ(50,DRG,.01),1,25)
  1. I $G(BCODE) D
  1. . S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT S PID=$P(VADM(2),"^",2) K VADM
  1. . S PRPT="PID: "_PID_"/MED: "_DRGNAM_"/"
  1. K DIR S DIR(0)="FOA^1:15",DIR("A")=$S($G(STOCK):"PRODUCT NDC: ",1:PRPT_"NDC: "),DIR("B")=$G(^TMP($J,"PSONDCFM",1)) I DIR("B")="" K DIR("B")
  1. S DIR("?")="^D NDCHLP^PSONDCUT",DIR("??")="^D NDCHLP2^PSONDCUT" D ^DIR I $D(DIRUT) S NDC="^" G END
  1. I Y'?.N S NDC=Y I '$D(^TMP($J,"PSONDCDP",NDC)) W !,$C(7) D NDCHLP W !,$C(7) G ASK
  1. I Y?.N D I NDC="" W !,$C(7) D NDCHLP2 W !,$C(7) G ASK
  1. . I $L(Y)=11 S NDC=$$NDCFMT^PSSNDCUT(Y) D Q
  1. . . S:NDC'="" NDC=$S($D(^TMP($J,"PSONDCDP",NDC)):NDC,1:"")
  1. . S NDC=$G(^TMP($J,"PSONDCFM",+Y))
  1. W " ",NDC
  1. ;
  1. END K ^TMP($J,"PSONDCDP"),^TMP($J,"PSONDCFM")
  1. Q
  1. ;
  1. SAVNDC(RX,RFL,NDC,CMP,DRG,FROM) ; Saves the NDC in the PRESCRIPTION and DRUG files
  1. ; Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill Number (#52.1)
  1. ; (r) NDC - NDC Number
  1. ; (o) CMP - CMOP? (1-YES/0-NO)
  1. ; (o) DRG - Save in the DRUG file (1-YES/0-NO) ((Def: 0)
  1. ; (o) FROM - Calling function
  1. ;
  1. S NDC=$$NDCFMT^PSSNDCUT(NDC) I NDC="" Q
  1. ;
  1. ;- Saving the NDC in the PRESCRIPTION file (#52)
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. ;
  1. I '$D(FROM) N FROM S FROM=""
  1. N PPDU S PPDU="",PPDU=$$GPPDU(RX,RFL,NDC,,1,FROM)
  1. ;
  1. N DA,DIE,DR
  1. I 'RFL S DIE="^PSRX(",DA=RX,DR="27///"_NDC D ^DIE
  1. I RFL,$D(^PSRX(RX,1,RFL,0)) D
  1. . S DIE="^PSRX("_RX_",1,",DA(1)=RX,DA=RFL,DR="11///"_NDC D ^DIE
  1. ;
  1. ;- Saving the NDC in the DRUG file (#50) only if drug is e-payable
  1. I $G(DRG)&($$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE") D SAVNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),NDC,$G(CMP))
  1. Q
  1. ;
  1. GETNDC(RX,RFL) ; Returns the Rx NDC #
  1. ; Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill #
  1. ; Output: NDC - Rx NDC #
  1. N NDC,I S NDC=""
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. I RFL S NDC=$$GET1^DIQ(52.1,RFL_","_RX,11)
  1. I 'RFL!(NDC="") S NDC=$$GET1^DIQ(52,RX,27)
  1. Q $$NDCFMT^PSSNDCUT(NDC)
  1. ;
  1. GPPDU(RX,RFL,NDC,DRUG,SAVE,FROM) ;-get Price per dispense unit for the NDC
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill Number (#52.1)
  1. ; (r) NDC - National Drug Code
  1. ; (o) DRUG - Drug IEN from (#50)
  1. ; (o) SAVE - 1 (one) means save the PPDU and 0 (zero) means don't save it
  1. ; (o) FROM - Calling function
  1. ;
  1. ;Output: (r) PPDU - Price Per Dispense Unit for the NDC on the drug in file (#50)
  1. ; OR "^" if no valid NDC or "^" entered
  1. ;
  1. N SYN,Z,SNDC,DEFNDC,PPDUARR,DEFPPDU,CMOP
  1. I '$G(DRUG) N DRUG S DRUG="",DRUG=$$GET1^DIQ(52,RX,6,"I")
  1. I '$D(RFL) S RFL="",RFL=$$LSTRFL^PSOBPSU1(RX)
  1. I '$G(SAVE) S SAVE=0
  1. S DEFNDC=$$NDCFMT^PSSNDCUT($$GET1^DIQ(50,DRUG,31))
  1. S (DEFPPDU,PPDU)=$$GET1^DIQ(50,DRUG,16)
  1. S:DEFNDC'="" PPDUARR(DEFNDC)=PPDU
  1. S SYN=0
  1. ;
  1. F S SYN=$O(^PSDRUG(DRUG,1,SYN)) Q:SYN="" D
  1. . S Z=$G(^PSDRUG(DRUG,1,SYN,0)),SNDC=$$NDCFMT^PSSNDCUT($P(Z,"^",2)) I SNDC="" Q
  1. . S:$P(Z,"^",8)'="" PPDUARR(SNDC)=$P(Z,"^",8)
  1. I $G(NDC),$D(PPDUARR(NDC)) S PPDU=$G(PPDUARR(NDC))
  1. I $$MWC^PSOBPSU2(RX,RFL)="C" D
  1. . I $D(FROM) Q:FROM="PE"!(FROM="PP") ;if FROM passed, pull early from suspense gets price by NDC
  1. . S PPDU=DEFPPDU ;use default NDC for CMOP fills
  1. I SAVE&(PPDU'="") D SPPDU(RX,RFL,PPDU)
  1. Q PPDU
  1. ;
  1. SPPDU(RX,RFL,PPDU) ;save price per dispense unit
  1. N DIE,DA,DR
  1. I 'RFL S DIE="^PSRX(",DA=RX,DR="17///"_PPDU D ^DIE
  1. I RFL,$D(^PSRX(RX,1,RFL,0)) D
  1. . S DIE="^PSRX("_RX_",1,",DA(1)=RX,DA=RFL,DR="1.2///"_PPDU D ^DIE
  1. Q
  1. ;
  1. NDCHLP2 ;Help Text for ?? for the NDC Code Selection
  1. I X["?" D
  1. .W !!,"Enter a valid "_$S($G(STOCK):"Product ",1:"")_"NDC. Valid NDC's are those defined for the drug in"
  1. .W !,"Drug file (#50) as an NDC of a synonym or the default NDC."
  1. I $G(STOCK)&(X["?") D
  1. . W !!,"If the Product is not listed below, the NDC must be entered as a synonym for"
  1. . W !,"the drug before NDC validation of the prescription may be completed.",!
  1. ;
  1. NDCHLP ; Help Text for the NDC Code Selection
  1. N I
  1. I $G(STOCK)&(X'["?") D ;help text for NDC Validation option
  1. . W !,"The NDC # entered is either invalid or there is not a matching synonym"
  1. . W !,"for NDC "_$S($G(Y):Y,1:DIR("B"))_" defined for "_DRGNAM_" in the"
  1. . W !,"drug file. Please verify that you have selected the correct product.",!
  1. . W !,"If the product is correct, the NDC must be entered as a synonym for"
  1. . W !,"the drug before NDC validation of the prescription may be completed.",!
  1. W !,"Select one of the following valid NDC code(s) below "_$S($G(STOCK):"or enter ^ to exit",1:"")_": ",!
  1. S I=0 F S I=$O(^TMP($J,"PSONDCFM",I)) Q:'I D
  1. . W !?10,$J(I,2)," - ",^TMP($J,"PSONDCFM",I)
  1. Q