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