- 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 Jan 18, 2025@03:32:28 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