APSPRCUI ;MSC/JS QUERY APELON FOR RXNORM VALUE FOR DRUG NDC OR DRUG VUID ;11-Oct-2013 13:15;DU
;;7.0;IHS PHARMACY MODIFICATIONS;**1017**;Sep 23, 2004;Build 40
;
; TAGS:
; LIST - List Drug file #50 entry RXNorm field
; QUERY - Query Apelon site for selected Drug file entry, defaults to NDC code, or VUID (if it exists)
; UPONE - Set Drug file entry RXCUI field with Apelon RXNorm value returned, or manually entered
; UPALL - Set All Drug file entries RXCUI field with Apelon RXNorm value returned
; QRXNORM - Query Drug file entry passing parameter IEN50
; SQUERY - API called from PSSCOMMON input template to add RXNORM code for new Drug file entry
; SUPALL - Tasked Set All Drug file entries RXCUI field with Apelon RXNorm value returned
; ONEUP - Menu option - Set Drug file entry RXCUI field with Apelon RXNorm value returned, or manually entered
;
Q ; -- interactive use call tag MAIN
;
MAIN ;
I $G(DUZ)="" S DUZ=.5,DUZ(0)="@"
S U="^" D HOME^%ZIS
S $P(LINE,"-",80)=""
D NDC
S NOWI=$$NOW^XLFDT S Y=NOWI X ^DD("DD") S NOWE=Y
NEW DIR,X,Y
K DIR,X,Y
S DIR(0)="S^Q:Query;L:List File RXNorm Codes (STATS);O:Update One RXNorm Entry;A:Update ALL RXNorm Entries;X:Exit"
S DIR("B")="X"
W ! D ^DIR
G EXIT:Y=0!($D(DIRUT))
I Y="L" D LIST G MAIN
I Y="Q" D QUERY G MAIN
I Y="O" D UPONE G MAIN
I Y="A" D UPALL G MAIN
I Y="X" G EXIT
G EXIT
;
LIST ;
NEW DIR,X,Y
S DIR(0)="Y",DIR("A")="List the Drug File RXNorm data",DIR("B")="Y"
W ! D ^DIR
G EXIT:Y=0!($D(DIRUT))
I Y=1 D
.W @IOF,!!,"DRUG FILE RXNORM LIST",?50,"DATE: ",NOWE,!,LINE,!,"DRUG"
.NEW IEN50
.S (IEN50,TOTAL,TOTRXY,TOTRXN,TOTNDCY,TOTNDCN)=0
.F S IEN50=$O(^PSDRUG(IEN50)) Q:IEN50="" D
..Q:'$D(^PSDRUG(IEN50,0))
..NEW DRUGNM S DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E") S DRUGNM=DRUGNM_" ("_IEN50_")"
..NEW NDC S NDC=$$GET1^DIQ(50,IEN50,31,"E")
..NEW RXNORM S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
..I $G(RXNORM)]"" S TOTRXY=TOTRXY+1
..I $G(RXNORM)="" S TOTRXN=TOTRXN+1
..I $G(NDC)]"" S TOTNDCY=TOTNDCY+1
..I $G(NDC)="" S TOTNDCN=TOTNDCN+1
..W !,"DRUG: ",DRUGNM
..W !?5,"NDC: ",NDC,?35,"RXNorm: ",RXNORM
..S TOTAL=TOTAL+1
..Q
W !!,"TOTAL DRUG ENTRIES WITH RXNORM CODES: ",TOTRXY
W !,"TOTAL DRUG ENTRIES WITH NO RXNORM CODES: ",TOTRXN
W !,"TOTAL DRUG ENTRIES WITH NDC CODES: ",TOTNDCY
W !,"TOTAL DRUG ENTRIES WITH NO NDC CODES: ",TOTNDCN
W !!,"TOTAL DRUG ENTRIES: ",TOTAL
Q
;
QUERY ;
NEW DIR,X,Y,IEN50
S DIR(0)="P^50:EMZ",DIR("A")="Enter DRUG file entry"
W ! D ^DIR
Q:$D(DIRUT)
S IEN50=+Y
Q:'$D(^PSDRUG(IEN50,0))
NEW DRUGNM S DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E") S DRUGNM=DRUGNM_" ("_IEN50_")"
NEW NDC S NDC=$$GET1^DIQ(50,IEN50,31,"E") S:NDC="" NDC="NONE"
NEW RXNORM S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E") S:RXNORM="" RXNORM="NONE"
W !,"DRUG: ",DRUGNM,!,?30,"NDC:",?40,NDC,!?30,"RXNorm:",?40,RXNORM
Q
; -- if APSPDIS parameter set, make a 'quiet' call
SQUERY(IEN50,APSPDIS) ;
N RXNORM,NDC,NDCPAR
S RXNORM=""
I '$D(^PSDRUG(IEN50,0))="" Q ""
D NDC
I NDCPAR="P" S NDC=$$NDC^APSPES4(IEN50)
E S NDC=$$GET1^DIQ(50,IEN50,31,"E") S:NDC="" NDC="NONE"
I NDCPAR="L" I NDC="NONE" D ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
.S NDC=$$NDC^APSPES4(IEN50)
.S:NDC="" NDC="NONE"
I NDC="NONE" Q "-1^NDC not found for DRUG entry"
NEW DRUGNM S DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E") S DRUGNM=DRUGNM_" ("_IEN50_")"
NEW NDCAP S NDCAP=NDC
S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
D APELON(.RXNORM)
Q RXNORM
;
; -- KIDS Post-Install Update - Queued update for all Drug file entries
SUPALL ;
N APSPARR
S APSPARR(1)=""
S APSPARR(2)="Checking the Apelon utility installation..."
S APSPARR(3)=""
D MES^XPDUTL(.APSPARR) K APSPARR
;
NEW APELYES S APELYES=$$TEST^CIAUOS("DI2RX^BSTSAPI")
;
N APSPARR
S APSPARR(1)=""
I APELYES S APSPARR(2)="Tasking DRUG File #50 RXCUI field update..."
E S APSPARR(2)="The Apelon utility has not been installed, aborting update..."
S APSPARR(3)=""
D MES^XPDUTL(.APSPARR) K APSPARR
Q:APELYES=0
;-- schedule TM job to run 'NOW' --
S ZTIO=""
;S ZTDTH=$H
S ZTRTN="DQ^APSPRCUI"
S ZTDESC="Tasked Update FILE #50 'RXCUI' field from KIDs build "_$G(XPDNM)
I $G(XPDNM)]"" S ZTSAVE("XPDNM")=""
D ^%ZTLOAD K IO("Q")
D HOME^%ZIS
N APSPARR
S APSPARR(1)=""
S APSPARR(2)="The update for DRUG file field RXCUI"_$S($G(ZTSK)]"":" is tasked #"_ZTSK,1:" has NOT been tasked")
S APSPARR(3)=""
D MES^XPDUTL(.APSPARR) K APSPARR
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
;
NDC ; -- check XPAR parameter APSP RXNORM NDC LOOKUP for NDC lookup method, default value is 'P' - VA PRODUCT NDC lookup
S NDCDIV=$$GET^XPAR("DIV","APSP RXNORM NDC LOOKUP")
S NDCSYS=$$GET^XPAR("SYS","APSP RXNORM NDC LOOKUP")
I NDCDIV="" S NDCPAR=NDCSYS S:NDCPAR="" NDCPAR="P" Q
I NDCDIV]"" D
.I $G(DUZ(2))="" S NDCPAR=NDCSYS S:NDCPAR="" NDCPAR="P" Q
.NEW XPIEN
.S XPIEN="",XPIEN=$O(^XTV(8989.51,"B","APSP RXNORM NDC LOOKUP",XPIEN))
.I XPIEN="" S NDCPAR="P" Q
.NEW XPAC,FLG
.S XPAC=""
.S FLG=0
.F S XPAC=$O(^XTV(8989.5,"AC",XPIEN,XPAC)) Q:XPAC=""!(FLG=1) D
..I XPAC[";DIC(4," I XPAC[$G(DUZ(2)) S NDCPAR=NDCDIV,FLG=1 Q
.S:$G(NDCPAR)="" NDCPAR=NDCSYS S:NDCPAR="" NDCPAR="P"
Q
;
TMPGBL(X) ;EP
K ^TMP("APSPRCUI",$J) Q $NA(^($J))
;
DQ ; -- tasked update from KIDs Post-Install for ALL Drug file entries job starts here
S APSPDIS=1 ; -- skip the Apelon call dialog
D NDC
NEW IEN50,RXNORM
S IEN50=0,RXNORM=""
F S IEN50=$O(^PSDRUG(IEN50)) Q:IEN50="" D
.Q:'$D(^PSDRUG(IEN50,0))
.I NDCPAR="P" S NDC=$$NDC^APSPES4(IEN50)
.E S NDC=$$GET1^DIQ(50,IEN50,31,"E") S:NDC="" NDC="NONE"
.I NDCPAR="L" I NDC="NONE" D ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
..S NDC=$$NDC^APSPES4(IEN50)
..S:NDC="" NDC="NONE"
.I NDC="NONE" Q
.NEW NDCAP S NDCAP=NDC
.D APELON(RXNORM)
K APSPDIS,NDC,NDCDIV,NDCPAR,NDCSYS
Q
;
UPONE ;
W @IOF,!!
W !,"This option will update a DRUG file entry RXNorm field using the Apelon Tool",!,"or alternatively by data entry.",!
NEW DIR,X,Y
K DIR,X,Y
S DIR(0)="Y",DIR("A")="Do you want to update the Drug File RXNorm data using the Apelon Tool",DIR("B")="Y"
S DIR("?")="Enter 'NO' to manually enter the RXNorm data, or '^' to quit."
W ! D ^DIR
Q:$D(DIRUT)
S USEAP=Y
I USEAP I '$$TEST^CIAUOS("DI2RX^BSTSAPI") W !!,"The Apelon utility has not been installed on this account, aborting update." Q
K DIR,X,Y
S DIR(0)="P^50:EMZ",DIR("A")="Enter DRUG file entry"
W ! D ^DIR
Q:$D(DIRUT)
K IEN50 S IEN50=+Y
Q:'$D(^PSDRUG(IEN50,0))
D NDC
W:'USEAP !!,$S(NDCPAR="L":"Using local DRUG file NDC data...",1:"Using VA PRODUCT file NDC data...")
W:USEAP !!,$S(NDCPAR="L":"Using local DRUG file NDC data for Apelon query...",1:"Using VA PRODUCT file NDC value used for Apelon query...")
NEW DRUGNM S DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E") S DRUGNM=DRUGNM_" ("_IEN50_")"
NEW NDC
I NDCPAR="P" S NDC=$$NDC^APSPES4(IEN50)
E S NDC=$$GET1^DIQ(50,IEN50,31,"E") S:NDC="" NDC="NONE"
I NDCPAR="L" I NDC="NONE" D ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
.W !,"Local NDC field not set, alternately using NDC code from VA PRODUCT file...",!
.S NDC=$$NDC^APSPES4(IEN50)
S:NDC="" NDC="NONE"
NEW RXNORM S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E") S:RXNORM="" RXNORM="NONE"
W !,DRUGNM,?55,NDC
I USEAP I NDC="NONE" W !!,"No NDC code found for this entry, cannot query Apelon for update.",! Q
NEW NDCAP S NDCAP=NDC
I 'USEAP D FLDEDIT(IEN50)
I USEAP D APELON(RXNORM)
Q
;
UPALL ;
I '$$TEST^CIAUOS("DI2RX^BSTSAPI") W !!,"The Apelon utility has not been installed on this account, aborting update." Q
NEW DIR,X,Y
K DIR,X,Y
S DIR(0)="Y",DIR("A")="Update the Drug File RXNorm data for ALL entries",DIR("B")="Y"
W ! D ^DIR
G EXIT:Y=0!($D(DIRUT))
D NDC
NEW IEN50
S IEN50=0
F S IEN50=$O(^PSDRUG(IEN50)) Q:IEN50="" D
.Q:'$D(^PSDRUG(IEN50,0))
.NEW DRUGNM S DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E") S DRUGNM=DRUGNM_" ("_IEN50_")"
.W !!,$S(NDCPAR="L":"Checking local DRUG file NDC data for Apelon query...",1:"VA PRODUCT file NDC value used for Apelon query...")
.NEW NDC
.I NDCPAR="P" S NDC=$$NDC^APSPES4(IEN50)
.E S NDC=$$GET1^DIQ(50,IEN50,31,"E") S:NDC="" NDC="NONE"
.I NDCPAR="L" I NDC="NONE" D ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
..W !,"Local NDC field not set, alternately using NDC code from VA PRODUCT file...",!
..S NDC=$$NDC^APSPES4(IEN50)
.S:NDC="" NDC="NONE"
.NEW RXNORM S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E") S:RXNORM="" RXNORM="NONE"
.I NDC="NONE" W !,"Skipping entry ",DRUGNM," no NDC code",! Q
.W !,DRUGNM,?55,NDC
.NEW NDCAP S NDCAP=NDC
.D APELON(RXNORM)
Q
; Query DRUG file entry, returns IEN ^ Drug Name ^ NDC Code ^ RXNorm
; Input = DRUG file #50 IEN
QRXNORM(RET,IEN50) ;
I $G(IEN50)="" Q "-1^Missing Drug file #50 IEN parameter"
I '$D(^PSDRUG(IEN50,0))="" Q ""
NEW INFO50
S INFO50=0
D NDC
I NDCPAR="P" S NDC=$$NDC^APSPES4(IEN50)
E S NDC=$$GET1^DIQ(50,IEN50,31,"E") S:NDC="" NDC="NONE"
I NDCPAR="L" I NDC="NONE" D ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
.S NDC=$$NDC^APSPES4(IEN50)
.S:NDC="" NDC="NONE"
NEW DRUGNM S DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E") S DRUGNM=DRUGNM_" ("_IEN50_")"
NEW RXNORM S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E") S:RXNORM="" RXNORM="NONE"
S INFO50=$G(IEN50)_U_$G(DRUGNM)_U_$G(NDC)_U_$G(RXNORM)
Q INFO50
;
FLDEDIT(IEN50) ; -- update RXCUI field with data entry
NEW DIR,X,Y,RXCUI
K DIR,X,Y
S DIR(0)="N^1:9999999",DIR("A")="Enter the RXNorm numeric code"
W ! D ^DIR
Q:$D(DIRUT)
S RXCUI=Y
NEW DA,DIE,DR,X,Y
K DA,DIE,DR,X,Y
S DA=IEN50
S DIE="^PSDRUG("
S DR="9999999.27///^S X=RXCUI"
D ^DIE
S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E") S:RXNORM="" RXNORM="NONE"
W !,$S(RXNORM=RXCUI:"ENTRY UPDATED",1:"ENTRY *NOT* UPDATED")
I RXNORM=RXCUI W " - RXCUI field set to: ",RXNORM
Q
;
APELON(RXNORM) ; -- query Apelon site for drug NDC code, if RXCUI data returned updated DRUG file entry(s)
; -- if $G(APSPDIS)="", display dialog
N NDCAPL,RXCUI,IN,ZDATA,UPOK,VUID,VUIDOK
S RXNORM=""
Q:$G(NDCAP)=""
S UPOK=0
S NDCAP=$$STRIP^XLFSTR(NDCAP,"-")
S NDCAPL=$L(NDCAP) I NDCAPL>11 I $E(NDCAP,1)=0 S NDCAP=$E(NDCAP,2,999) ; strip off leading 0
W:$G(APSPDIS)="" !,"Querying Apelon site..."
S IN=NDCAP_"^N" S ZDATA=$$DI2RX^BSTSAPI(IN)
I ZDATA="" D
.W:$G(APSPDIS)="" "NDC query failed, trying VUID query..."
.D VUID
.I VUIDOK=0 W:$G(APSPDIS)="" !,"VUID code not onfile, skipping entry"
.I VUIDOK=1 D
..;Input (from DI2RX^BSTSAPIF)
..; IN - P1 - The exact term to lookup
..; - P2 - Lookup Type (N-NDC,V-VUID)
..S IN=VUID_"^V" S ZDATA=$$DI2RX^BSTSAPI(IN)
;First try for trade name (3rd piece), if not there use the data in field 1
S RXCUI=$P(ZDATA,U,3)
S TTY=$P(ZDATA,U,5)
I RXCUI="" S RXCUI=$P(ZDATA,U,1)
I $G(RXCUI)]"" S UPOK=1
I UPOK=0 Q
I UPOK=1 D
.NEW DA,DIE,DR,X,Y
.S DA=IEN50
.S DIE="^PSDRUG("
.S DR="9999999.27///^S X=RXCUI"
.D ^DIE
.S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E") S:RXNORM="" RXNORM="NONE"
.W:$G(APSPDIS)="" $S(RXNORM=RXCUI:"ENTRY UPDATED",1:"ENTRY *NOT* UPDATED")
.I RXNORM=RXCUI W:$G(APSPDIS)="" " - RXCUI field set to: ",RXNORM
.S RXNORM=RXCUI_U_TTY
Q
;
VUID ; -- alternate Drug VUID lkup here if no NDC available
S VUIDOK=0
N VAPNAME,NDNODE,PSNF
S NDNODE=$G(^PSDRUG(IEN50,"ND")),VAPNAME=$P(NDNODE,U,2)
Q:VAPNAME=""
S PSNF="",PSNF=$O(^PSNDF(50.68,"B",VAPNAME,PSNF))
Q:PSNF=""
N VUIDND,VUIDMSTR
S VUIDND=$G(^PSNDF(50.68,PSNF,"VUID"))
Q:VUIDND=""
S VUID=$P(VUIDND,U,1),VUIDMSTR=$P(VUIDND,U,2)
Q:VUID=""!(VUIDMSTR="")
I VUIDMSTR=1 I $L(VUID)=7 S VUIDOK=1
Q
;
ONEUP ; -- XQ menu option to update RXNorm field for DRUG file entry
S U="^" D HOME^%ZIS
NEW USEAP,IEN50,NDC,NDCDIV,NDCSYS,NDCPAR,DRUGNM
W @IOF,!!
W !,"This option will update a DRUG file entry RXNorm field using the Apelon Tool",!,"or alternatively by data entry.",!
NEW DIR,X,Y
K DIR,X,Y
S DIR(0)="Y",DIR("A")="Do you want to update the Drug File RXNorm data using the Apelon Tool",DIR("B")="Y"
S DIR("?")="Enter 'NO' to manually enter the RXNorm data, or '^' to quit."
W ! D ^DIR
G EXIT:$D(DIRUT)
S USEAP=Y
I USEAP I '$$TEST^CIAUOS("DI2RX^BSTSAPI") W !!,"The Apelon utility has not been installed on this account, aborting update." G EXIT
K DIR,X,Y
S DIR(0)="P^50:EMZ",DIR("A")="Enter DRUG file entry"
W ! D ^DIR
G EXIT:$D(DIRUT)
K IEN50 S IEN50=+Y
I '$D(^PSDRUG(IEN50,0)) W !!,"DRUG file entry not available for editing",! G ONEUP
D NDC
W:'USEAP !!,$S(NDCPAR="L":"Using local DRUG file NDC data...",1:"Using VA PRODUCT file NDC data...")
W:USEAP !!,$S(NDCPAR="L":"Using local DRUG file NDC data for Apelon query...",1:"Using VA PRODUCT file NDC value used for Apelon query...")
NEW DRUGNM S DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E") S DRUGNM=DRUGNM_" ("_IEN50_")"
NEW NDC
I NDCPAR="P" S NDC=$$NDC^APSPES4(IEN50)
E S NDC=$$GET1^DIQ(50,IEN50,31,"E") S:NDC="" NDC="NONE"
I NDCPAR="L" I NDC="NONE" D ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
.W !,"Local NDC field not set, alternately using NDC code from VA PRODUCT file...",!
.S NDC=$$NDC^APSPES4(IEN50)
S:NDC="" NDC="NONE"
NEW RXNORM S RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E") S:RXNORM="" RXNORM="NONE"
W !,DRUGNM,?55,NDC
I USEAP I NDC="NONE" W !!,"No NDC code found for this entry, cannot query Apelon for update.",! G ONEUP
NEW NDCAP S NDCAP=NDC
I 'USEAP D FLDEDIT(IEN50)
I USEAP D APELON(RXNORM)
NEW DIR,X,Y
S DIR(0)="E",DIR("A")="Press RETURN to continue" W !! D ^DIR
G ONEUP
;
EXIT ;
K DIRUT,IN,LINE,NOWE,NOWI,TOTAL,TOTNDCY,TOTNDCN,TOTRXN,TOTRXY,VUIDOK,IEN50,ZDATA
K APSPDIS,NDC,NDCAPL,UPOK,RXCUI,NDCDIV,NDCSYS,NDCPAR,USEAP
Q
ROUTES ;Enter old SNOMED medication routes
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,DIR
S ZTRTN="UPROUTE^APSPRCUI",ZTIO="",ZTSAVE("DUZ")=""
W !,"Tasking MEDICATION ROUTE #51.2 SNOMED CODE Update"
S ZTDESC="Store SNOMED on med routes mapped to standard route file"
D ^%ZTLOAD
I $G(ZTSK) D
.W !!,"A task has been queued in the background."
.W !," The task number is "_$G(ZTSK)_"."
Q
UPROUTE ;Update local medication routes that are mapped
N MEDIEN,PSSDMRNW,PSSMRNM,SNOMED,ZDATA,IN,ERR,FDA,IENS,FNUM
S MEDIEN=0 F S MEDIEN=$O(^PS(51.2,MEDIEN)) Q:'+MEDIEN D
.S PSSDMRNW=$P($G(^PS(51.2,MEDIEN,1)),"^")
.Q:PSSDMRNW=""
.S PSSMRNM=$P($G(^PS(51.23,PSSDMRNW,0)),"^")
.S IN=PSSMRNM_"^32774" S ZDATA=$$ASSOC^BSTSAPI(IN)
.S SNOMED=$P(ZDATA,U,1)
.S FNUM=51.2
.S IENS=MEDIEN_","
.S FDA=$NA(FDA(FNUM,IENS))
.S @FDA@(9999999.01)=SNOMED
.D FILE^DIE("E","FDA","ERR")
Q
APSPRCUI ;MSC/JS QUERY APELON FOR RXNORM VALUE FOR DRUG NDC OR DRUG VUID ;11-Oct-2013 13:15;DU
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1017**;Sep 23, 2004;Build 40
+2 ;
+3 ; TAGS:
+4 ; LIST - List Drug file #50 entry RXNorm field
+5 ; QUERY - Query Apelon site for selected Drug file entry, defaults to NDC code, or VUID (if it exists)
+6 ; UPONE - Set Drug file entry RXCUI field with Apelon RXNorm value returned, or manually entered
+7 ; UPALL - Set All Drug file entries RXCUI field with Apelon RXNorm value returned
+8 ; QRXNORM - Query Drug file entry passing parameter IEN50
+9 ; SQUERY - API called from PSSCOMMON input template to add RXNORM code for new Drug file entry
+10 ; SUPALL - Tasked Set All Drug file entries RXCUI field with Apelon RXNorm value returned
+11 ; ONEUP - Menu option - Set Drug file entry RXCUI field with Apelon RXNorm value returned, or manually entered
+12 ;
+13 ; -- interactive use call tag MAIN
QUIT
+14 ;
MAIN ;
+1 IF $GET(DUZ)=""
SET DUZ=.5
SET DUZ(0)="@"
+2 SET U="^"
DO HOME^%ZIS
+3 SET $PIECE(LINE,"-",80)=""
+4 DO NDC
+5 SET NOWI=$$NOW^XLFDT
SET Y=NOWI
XECUTE ^DD("DD")
SET NOWE=Y
+6 NEW DIR,X,Y
+7 KILL DIR,X,Y
+8 SET DIR(0)="S^Q:Query;L:List File RXNorm Codes (STATS);O:Update One RXNorm Entry;A:Update ALL RXNorm Entries;X:Exit"
+9 SET DIR("B")="X"
+10 WRITE !
DO ^DIR
+11 IF Y=0!($DATA(DIRUT))
GOTO EXIT
+12 IF Y="L"
DO LIST
GOTO MAIN
+13 IF Y="Q"
DO QUERY
GOTO MAIN
+14 IF Y="O"
DO UPONE
GOTO MAIN
+15 IF Y="A"
DO UPALL
GOTO MAIN
+16 IF Y="X"
GOTO EXIT
+17 GOTO EXIT
+18 ;
LIST ;
+1 NEW DIR,X,Y
+2 SET DIR(0)="Y"
SET DIR("A")="List the Drug File RXNorm data"
SET DIR("B")="Y"
+3 WRITE !
DO ^DIR
+4 IF Y=0!($DATA(DIRUT))
GOTO EXIT
+5 IF Y=1
Begin DoDot:1
+6 WRITE @IOF,!!,"DRUG FILE RXNORM LIST",?50,"DATE: ",NOWE,!,LINE,!,"DRUG"
+7 NEW IEN50
+8 SET (IEN50,TOTAL,TOTRXY,TOTRXN,TOTNDCY,TOTNDCN)=0
+9 FOR
SET IEN50=$ORDER(^PSDRUG(IEN50))
IF IEN50=""
QUIT
Begin DoDot:2
+10 IF '$DATA(^PSDRUG(IEN50,0))
QUIT
+11 NEW DRUGNM
SET DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E")
SET DRUGNM=DRUGNM_" ("_IEN50_")"
+12 NEW NDC
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
+13 NEW RXNORM
SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
+14 IF $GET(RXNORM)]""
SET TOTRXY=TOTRXY+1
+15 IF $GET(RXNORM)=""
SET TOTRXN=TOTRXN+1
+16 IF $GET(NDC)]""
SET TOTNDCY=TOTNDCY+1
+17 IF $GET(NDC)=""
SET TOTNDCN=TOTNDCN+1
+18 WRITE !,"DRUG: ",DRUGNM
+19 WRITE !?5,"NDC: ",NDC,?35,"RXNorm: ",RXNORM
+20 SET TOTAL=TOTAL+1
+21 QUIT
End DoDot:2
End DoDot:1
+22 WRITE !!,"TOTAL DRUG ENTRIES WITH RXNORM CODES: ",TOTRXY
+23 WRITE !,"TOTAL DRUG ENTRIES WITH NO RXNORM CODES: ",TOTRXN
+24 WRITE !,"TOTAL DRUG ENTRIES WITH NDC CODES: ",TOTNDCY
+25 WRITE !,"TOTAL DRUG ENTRIES WITH NO NDC CODES: ",TOTNDCN
+26 WRITE !!,"TOTAL DRUG ENTRIES: ",TOTAL
+27 QUIT
+28 ;
QUERY ;
+1 NEW DIR,X,Y,IEN50
+2 SET DIR(0)="P^50:EMZ"
SET DIR("A")="Enter DRUG file entry"
+3 WRITE !
DO ^DIR
+4 IF $DATA(DIRUT)
QUIT
+5 SET IEN50=+Y
+6 IF '$DATA(^PSDRUG(IEN50,0))
QUIT
+7 NEW DRUGNM
SET DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E")
SET DRUGNM=DRUGNM_" ("_IEN50_")"
+8 NEW NDC
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
IF NDC=""
SET NDC="NONE"
+9 NEW RXNORM
SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
IF RXNORM=""
SET RXNORM="NONE"
+10 WRITE !,"DRUG: ",DRUGNM,!,?30,"NDC:",?40,NDC,!?30,"RXNorm:",?40,RXNORM
+11 QUIT
+12 ; -- if APSPDIS parameter set, make a 'quiet' call
SQUERY(IEN50,APSPDIS) ;
+1 NEW RXNORM,NDC,NDCPAR
+2 SET RXNORM=""
+3 IF '$DATA(^PSDRUG(IEN50,0))=""
QUIT ""
+4 DO NDC
+5 IF NDCPAR="P"
SET NDC=$$NDC^APSPES4(IEN50)
+6 IF '$TEST
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
IF NDC=""
SET NDC="NONE"
+7 ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
IF NDCPAR="L"
IF NDC="NONE"
Begin DoDot:1
+8 SET NDC=$$NDC^APSPES4(IEN50)
+9 IF NDC=""
SET NDC="NONE"
End DoDot:1
+10 IF NDC="NONE"
QUIT "-1^NDC not found for DRUG entry"
+11 NEW DRUGNM
SET DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E")
SET DRUGNM=DRUGNM_" ("_IEN50_")"
+12 NEW NDCAP
SET NDCAP=NDC
+13 SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
+14 DO APELON(.RXNORM)
+15 QUIT RXNORM
+16 ;
+17 ; -- KIDS Post-Install Update - Queued update for all Drug file entries
SUPALL ;
+1 NEW APSPARR
+2 SET APSPARR(1)=""
+3 SET APSPARR(2)="Checking the Apelon utility installation..."
+4 SET APSPARR(3)=""
+5 DO MES^XPDUTL(.APSPARR)
KILL APSPARR
+6 ;
+7 NEW APELYES
SET APELYES=$$TEST^CIAUOS("DI2RX^BSTSAPI")
+8 ;
+9 NEW APSPARR
+10 SET APSPARR(1)=""
+11 IF APELYES
SET APSPARR(2)="Tasking DRUG File #50 RXCUI field update..."
+12 IF '$TEST
SET APSPARR(2)="The Apelon utility has not been installed, aborting update..."
+13 SET APSPARR(3)=""
+14 DO MES^XPDUTL(.APSPARR)
KILL APSPARR
+15 IF APELYES=0
QUIT
+16 ;-- schedule TM job to run 'NOW' --
+17 SET ZTIO=""
+18 ;S ZTDTH=$H
+19 SET ZTRTN="DQ^APSPRCUI"
+20 SET ZTDESC="Tasked Update FILE #50 'RXCUI' field from KIDs build "_$GET(XPDNM)
+21 IF $GET(XPDNM)]""
SET ZTSAVE("XPDNM")=""
+22 DO ^%ZTLOAD
KILL IO("Q")
+23 DO HOME^%ZIS
+24 NEW APSPARR
+25 SET APSPARR(1)=""
+26 SET APSPARR(2)="The update for DRUG file field RXCUI"_$SELECT($GET(ZTSK)]"":" is tasked #"_ZTSK,1:" has NOT been tasked")
+27 SET APSPARR(3)=""
+28 DO MES^XPDUTL(.APSPARR)
KILL APSPARR
+29 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+30 QUIT
+31 ;
NDC ; -- check XPAR parameter APSP RXNORM NDC LOOKUP for NDC lookup method, default value is 'P' - VA PRODUCT NDC lookup
+1 SET NDCDIV=$$GET^XPAR("DIV","APSP RXNORM NDC LOOKUP")
+2 SET NDCSYS=$$GET^XPAR("SYS","APSP RXNORM NDC LOOKUP")
+3 IF NDCDIV=""
SET NDCPAR=NDCSYS
IF NDCPAR=""
SET NDCPAR="P"
QUIT
+4 IF NDCDIV]""
Begin DoDot:1
+5 IF $GET(DUZ(2))=""
SET NDCPAR=NDCSYS
IF NDCPAR=""
SET NDCPAR="P"
QUIT
+6 NEW XPIEN
+7 SET XPIEN=""
SET XPIEN=$ORDER(^XTV(8989.51,"B","APSP RXNORM NDC LOOKUP",XPIEN))
+8 IF XPIEN=""
SET NDCPAR="P"
QUIT
+9 NEW XPAC,FLG
+10 SET XPAC=""
+11 SET FLG=0
+12 FOR
SET XPAC=$ORDER(^XTV(8989.5,"AC",XPIEN,XPAC))
IF XPAC=""!(FLG=1)
QUIT
Begin DoDot:2
+13 IF XPAC[";DIC(4,"
IF XPAC[$GET(DUZ(2))
SET NDCPAR=NDCDIV
SET FLG=1
QUIT
End DoDot:2
+14 IF $GET(NDCPAR)=""
SET NDCPAR=NDCSYS
IF NDCPAR=""
SET NDCPAR="P"
End DoDot:1
+15 QUIT
+16 ;
TMPGBL(X) ;EP
+1 KILL ^TMP("APSPRCUI",$JOB)
QUIT $NAME(^($JOB))
+2 ;
DQ ; -- tasked update from KIDs Post-Install for ALL Drug file entries job starts here
+1 ; -- skip the Apelon call dialog
SET APSPDIS=1
+2 DO NDC
+3 NEW IEN50,RXNORM
+4 SET IEN50=0
SET RXNORM=""
+5 FOR
SET IEN50=$ORDER(^PSDRUG(IEN50))
IF IEN50=""
QUIT
Begin DoDot:1
+6 IF '$DATA(^PSDRUG(IEN50,0))
QUIT
+7 IF NDCPAR="P"
SET NDC=$$NDC^APSPES4(IEN50)
+8 IF '$TEST
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
IF NDC=""
SET NDC="NONE"
+9 ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
IF NDCPAR="L"
IF NDC="NONE"
Begin DoDot:2
+10 SET NDC=$$NDC^APSPES4(IEN50)
+11 IF NDC=""
SET NDC="NONE"
End DoDot:2
+12 IF NDC="NONE"
QUIT
+13 NEW NDCAP
SET NDCAP=NDC
+14 DO APELON(RXNORM)
End DoDot:1
+15 KILL APSPDIS,NDC,NDCDIV,NDCPAR,NDCSYS
+16 QUIT
+17 ;
UPONE ;
+1 WRITE @IOF,!!
+2 WRITE !,"This option will update a DRUG file entry RXNorm field using the Apelon Tool",!,"or alternatively by data entry.",!
+3 NEW DIR,X,Y
+4 KILL DIR,X,Y
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want to update the Drug File RXNorm data using the Apelon Tool"
SET DIR("B")="Y"
+6 SET DIR("?")="Enter 'NO' to manually enter the RXNorm data, or '^' to quit."
+7 WRITE !
DO ^DIR
+8 IF $DATA(DIRUT)
QUIT
+9 SET USEAP=Y
+10 IF USEAP
IF '$$TEST^CIAUOS("DI2RX^BSTSAPI")
WRITE !!,"The Apelon utility has not been installed on this account, aborting update."
QUIT
+11 KILL DIR,X,Y
+12 SET DIR(0)="P^50:EMZ"
SET DIR("A")="Enter DRUG file entry"
+13 WRITE !
DO ^DIR
+14 IF $DATA(DIRUT)
QUIT
+15 KILL IEN50
SET IEN50=+Y
+16 IF '$DATA(^PSDRUG(IEN50,0))
QUIT
+17 DO NDC
+18 IF 'USEAP
WRITE !!,$SELECT(NDCPAR="L":"Using local DRUG file NDC data...",1:"Using VA PRODUCT file NDC data...")
+19 IF USEAP
WRITE !!,$SELECT(NDCPAR="L":"Using local DRUG file NDC data for Apelon query...",1:"Using VA PRODUCT file NDC value used for Apelon query...")
+20 NEW DRUGNM
SET DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E")
SET DRUGNM=DRUGNM_" ("_IEN50_")"
+21 NEW NDC
+22 IF NDCPAR="P"
SET NDC=$$NDC^APSPES4(IEN50)
+23 IF '$TEST
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
IF NDC=""
SET NDC="NONE"
+24 ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
IF NDCPAR="L"
IF NDC="NONE"
Begin DoDot:1
+25 WRITE !,"Local NDC field not set, alternately using NDC code from VA PRODUCT file...",!
+26 SET NDC=$$NDC^APSPES4(IEN50)
End DoDot:1
+27 IF NDC=""
SET NDC="NONE"
+28 NEW RXNORM
SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
IF RXNORM=""
SET RXNORM="NONE"
+29 WRITE !,DRUGNM,?55,NDC
+30 IF USEAP
IF NDC="NONE"
WRITE !!,"No NDC code found for this entry, cannot query Apelon for update.",!
QUIT
+31 NEW NDCAP
SET NDCAP=NDC
+32 IF 'USEAP
DO FLDEDIT(IEN50)
+33 IF USEAP
DO APELON(RXNORM)
+34 QUIT
+35 ;
UPALL ;
+1 IF '$$TEST^CIAUOS("DI2RX^BSTSAPI")
WRITE !!,"The Apelon utility has not been installed on this account, aborting update."
QUIT
+2 NEW DIR,X,Y
+3 KILL DIR,X,Y
+4 SET DIR(0)="Y"
SET DIR("A")="Update the Drug File RXNorm data for ALL entries"
SET DIR("B")="Y"
+5 WRITE !
DO ^DIR
+6 IF Y=0!($DATA(DIRUT))
GOTO EXIT
+7 DO NDC
+8 NEW IEN50
+9 SET IEN50=0
+10 FOR
SET IEN50=$ORDER(^PSDRUG(IEN50))
IF IEN50=""
QUIT
Begin DoDot:1
+11 IF '$DATA(^PSDRUG(IEN50,0))
QUIT
+12 NEW DRUGNM
SET DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E")
SET DRUGNM=DRUGNM_" ("_IEN50_")"
+13 WRITE !!,$SELECT(NDCPAR="L":"Checking local DRUG file NDC data for Apelon query...",1:"VA PRODUCT file NDC value used for Apelon query...")
+14 NEW NDC
+15 IF NDCPAR="P"
SET NDC=$$NDC^APSPES4(IEN50)
+16 IF '$TEST
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
IF NDC=""
SET NDC="NONE"
+17 ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
IF NDCPAR="L"
IF NDC="NONE"
Begin DoDot:2
+18 WRITE !,"Local NDC field not set, alternately using NDC code from VA PRODUCT file...",!
+19 SET NDC=$$NDC^APSPES4(IEN50)
End DoDot:2
+20 IF NDC=""
SET NDC="NONE"
+21 NEW RXNORM
SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
IF RXNORM=""
SET RXNORM="NONE"
+22 IF NDC="NONE"
WRITE !,"Skipping entry ",DRUGNM," no NDC code",!
QUIT
+23 WRITE !,DRUGNM,?55,NDC
+24 NEW NDCAP
SET NDCAP=NDC
+25 DO APELON(RXNORM)
End DoDot:1
+26 QUIT
+27 ; Query DRUG file entry, returns IEN ^ Drug Name ^ NDC Code ^ RXNorm
+28 ; Input = DRUG file #50 IEN
QRXNORM(RET,IEN50) ;
+1 IF $GET(IEN50)=""
QUIT "-1^Missing Drug file #50 IEN parameter"
+2 IF '$DATA(^PSDRUG(IEN50,0))=""
QUIT ""
+3 NEW INFO50
+4 SET INFO50=0
+5 DO NDC
+6 IF NDCPAR="P"
SET NDC=$$NDC^APSPES4(IEN50)
+7 IF '$TEST
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
IF NDC=""
SET NDC="NONE"
+8 ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
IF NDCPAR="L"
IF NDC="NONE"
Begin DoDot:1
+9 SET NDC=$$NDC^APSPES4(IEN50)
+10 IF NDC=""
SET NDC="NONE"
End DoDot:1
+11 NEW DRUGNM
SET DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E")
SET DRUGNM=DRUGNM_" ("_IEN50_")"
+12 NEW RXNORM
SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
IF RXNORM=""
SET RXNORM="NONE"
+13 SET INFO50=$GET(IEN50)_U_$GET(DRUGNM)_U_$GET(NDC)_U_$GET(RXNORM)
+14 QUIT INFO50
+15 ;
FLDEDIT(IEN50) ; -- update RXCUI field with data entry
+1 NEW DIR,X,Y,RXCUI
+2 KILL DIR,X,Y
+3 SET DIR(0)="N^1:9999999"
SET DIR("A")="Enter the RXNorm numeric code"
+4 WRITE !
DO ^DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET RXCUI=Y
+7 NEW DA,DIE,DR,X,Y
+8 KILL DA,DIE,DR,X,Y
+9 SET DA=IEN50
+10 SET DIE="^PSDRUG("
+11 SET DR="9999999.27///^S X=RXCUI"
+12 DO ^DIE
+13 SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
IF RXNORM=""
SET RXNORM="NONE"
+14 WRITE !,$SELECT(RXNORM=RXCUI:"ENTRY UPDATED",1:"ENTRY *NOT* UPDATED")
+15 IF RXNORM=RXCUI
WRITE " - RXCUI field set to: ",RXNORM
+16 QUIT
+17 ;
APELON(RXNORM) ; -- query Apelon site for drug NDC code, if RXCUI data returned updated DRUG file entry(s)
+1 ; -- if $G(APSPDIS)="", display dialog
+2 NEW NDCAPL,RXCUI,IN,ZDATA,UPOK,VUID,VUIDOK
+3 SET RXNORM=""
+4 IF $GET(NDCAP)=""
QUIT
+5 SET UPOK=0
+6 SET NDCAP=$$STRIP^XLFSTR(NDCAP,"-")
+7 ; strip off leading 0
SET NDCAPL=$LENGTH(NDCAP)
IF NDCAPL>11
IF $EXTRACT(NDCAP,1)=0
SET NDCAP=$EXTRACT(NDCAP,2,999)
+8 IF $GET(APSPDIS)=""
WRITE !,"Querying Apelon site..."
+9 SET IN=NDCAP_"^N"
SET ZDATA=$$DI2RX^BSTSAPI(IN)
+10 IF ZDATA=""
Begin DoDot:1
+11 IF $GET(APSPDIS)=""
WRITE "NDC query failed, trying VUID query..."
+12 DO VUID
+13 IF VUIDOK=0
IF $GET(APSPDIS)=""
WRITE !,"VUID code not onfile, skipping entry"
+14 IF VUIDOK=1
Begin DoDot:2
+15 ;Input (from DI2RX^BSTSAPIF)
+16 ; IN - P1 - The exact term to lookup
+17 ; - P2 - Lookup Type (N-NDC,V-VUID)
+18 SET IN=VUID_"^V"
SET ZDATA=$$DI2RX^BSTSAPI(IN)
End DoDot:2
End DoDot:1
+19 ;First try for trade name (3rd piece), if not there use the data in field 1
+20 SET RXCUI=$PIECE(ZDATA,U,3)
+21 SET TTY=$PIECE(ZDATA,U,5)
+22 IF RXCUI=""
SET RXCUI=$PIECE(ZDATA,U,1)
+23 IF $GET(RXCUI)]""
SET UPOK=1
+24 IF UPOK=0
QUIT
+25 IF UPOK=1
Begin DoDot:1
+26 NEW DA,DIE,DR,X,Y
+27 SET DA=IEN50
+28 SET DIE="^PSDRUG("
+29 SET DR="9999999.27///^S X=RXCUI"
+30 DO ^DIE
+31 SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
IF RXNORM=""
SET RXNORM="NONE"
+32 IF $GET(APSPDIS)=""
WRITE $SELECT(RXNORM=RXCUI:"ENTRY UPDATED",1:"ENTRY *NOT* UPDATED")
+33 IF RXNORM=RXCUI
IF $GET(APSPDIS)=""
WRITE " - RXCUI field set to: ",RXNORM
+34 SET RXNORM=RXCUI_U_TTY
End DoDot:1
+35 QUIT
+36 ;
VUID ; -- alternate Drug VUID lkup here if no NDC available
+1 SET VUIDOK=0
+2 NEW VAPNAME,NDNODE,PSNF
+3 SET NDNODE=$GET(^PSDRUG(IEN50,"ND"))
SET VAPNAME=$PIECE(NDNODE,U,2)
+4 IF VAPNAME=""
QUIT
+5 SET PSNF=""
SET PSNF=$ORDER(^PSNDF(50.68,"B",VAPNAME,PSNF))
+6 IF PSNF=""
QUIT
+7 NEW VUIDND,VUIDMSTR
+8 SET VUIDND=$GET(^PSNDF(50.68,PSNF,"VUID"))
+9 IF VUIDND=""
QUIT
+10 SET VUID=$PIECE(VUIDND,U,1)
SET VUIDMSTR=$PIECE(VUIDND,U,2)
+11 IF VUID=""!(VUIDMSTR="")
QUIT
+12 IF VUIDMSTR=1
IF $LENGTH(VUID)=7
SET VUIDOK=1
+13 QUIT
+14 ;
ONEUP ; -- XQ menu option to update RXNorm field for DRUG file entry
+1 SET U="^"
DO HOME^%ZIS
+2 NEW USEAP,IEN50,NDC,NDCDIV,NDCSYS,NDCPAR,DRUGNM
+3 WRITE @IOF,!!
+4 WRITE !,"This option will update a DRUG file entry RXNorm field using the Apelon Tool",!,"or alternatively by data entry.",!
+5 NEW DIR,X,Y
+6 KILL DIR,X,Y
+7 SET DIR(0)="Y"
SET DIR("A")="Do you want to update the Drug File RXNorm data using the Apelon Tool"
SET DIR("B")="Y"
+8 SET DIR("?")="Enter 'NO' to manually enter the RXNorm data, or '^' to quit."
+9 WRITE !
DO ^DIR
+10 IF $DATA(DIRUT)
GOTO EXIT
+11 SET USEAP=Y
+12 IF USEAP
IF '$$TEST^CIAUOS("DI2RX^BSTSAPI")
WRITE !!,"The Apelon utility has not been installed on this account, aborting update."
GOTO EXIT
+13 KILL DIR,X,Y
+14 SET DIR(0)="P^50:EMZ"
SET DIR("A")="Enter DRUG file entry"
+15 WRITE !
DO ^DIR
+16 IF $DATA(DIRUT)
GOTO EXIT
+17 KILL IEN50
SET IEN50=+Y
+18 IF '$DATA(^PSDRUG(IEN50,0))
WRITE !!,"DRUG file entry not available for editing",!
GOTO ONEUP
+19 DO NDC
+20 IF 'USEAP
WRITE !!,$SELECT(NDCPAR="L":"Using local DRUG file NDC data...",1:"Using VA PRODUCT file NDC data...")
+21 IF USEAP
WRITE !!,$SELECT(NDCPAR="L":"Using local DRUG file NDC data for Apelon query...",1:"Using VA PRODUCT file NDC value used for Apelon query...")
+22 NEW DRUGNM
SET DRUGNM=$$GET1^DIQ(50,IEN50,.01,"E")
SET DRUGNM=DRUGNM_" ("_IEN50_")"
+23 NEW NDC
+24 IF NDCPAR="P"
SET NDC=$$NDC^APSPES4(IEN50)
+25 IF '$TEST
SET NDC=$$GET1^DIQ(50,IEN50,31,"E")
IF NDC=""
SET NDC="NONE"
+26 ; alternate lookup NDC code from VA PRODUCT file when local NDC field #31 is null
IF NDCPAR="L"
IF NDC="NONE"
Begin DoDot:1
+27 WRITE !,"Local NDC field not set, alternately using NDC code from VA PRODUCT file...",!
+28 SET NDC=$$NDC^APSPES4(IEN50)
End DoDot:1
+29 IF NDC=""
SET NDC="NONE"
+30 NEW RXNORM
SET RXNORM=$$GET1^DIQ(50,IEN50,9999999.27,"E")
IF RXNORM=""
SET RXNORM="NONE"
+31 WRITE !,DRUGNM,?55,NDC
+32 IF USEAP
IF NDC="NONE"
WRITE !!,"No NDC code found for this entry, cannot query Apelon for update.",!
GOTO ONEUP
+33 NEW NDCAP
SET NDCAP=NDC
+34 IF 'USEAP
DO FLDEDIT(IEN50)
+35 IF USEAP
DO APELON(RXNORM)
+36 NEW DIR,X,Y
+37 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
WRITE !!
DO ^DIR
+38 GOTO ONEUP
+39 ;
EXIT ;
+1 KILL DIRUT,IN,LINE,NOWE,NOWI,TOTAL,TOTNDCY,TOTNDCN,TOTRXN,TOTRXY,VUIDOK,IEN50,ZDATA
+2 KILL APSPDIS,NDC,NDCAPL,UPOK,RXCUI,NDCDIV,NDCSYS,NDCPAR,USEAP
+3 QUIT
ROUTES ;Enter old SNOMED medication routes
+1 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,DIR
+2 SET ZTRTN="UPROUTE^APSPRCUI"
SET ZTIO=""
SET ZTSAVE("DUZ")=""
+3 WRITE !,"Tasking MEDICATION ROUTE #51.2 SNOMED CODE Update"
+4 SET ZTDESC="Store SNOMED on med routes mapped to standard route file"
+5 DO ^%ZTLOAD
+6 IF $GET(ZTSK)
Begin DoDot:1
+7 WRITE !!,"A task has been queued in the background."
+8 WRITE !," The task number is "_$GET(ZTSK)_"."
End DoDot:1
+9 QUIT
UPROUTE ;Update local medication routes that are mapped
+1 NEW MEDIEN,PSSDMRNW,PSSMRNM,SNOMED,ZDATA,IN,ERR,FDA,IENS,FNUM
+2 SET MEDIEN=0
FOR
SET MEDIEN=$ORDER(^PS(51.2,MEDIEN))
IF '+MEDIEN
QUIT
Begin DoDot:1
+3 SET PSSDMRNW=$PIECE($GET(^PS(51.2,MEDIEN,1)),"^")
+4 IF PSSDMRNW=""
QUIT
+5 SET PSSMRNM=$PIECE($GET(^PS(51.23,PSSDMRNW,0)),"^")
+6 SET IN=PSSMRNM_"^32774"
SET ZDATA=$$ASSOC^BSTSAPI(IN)
+7 SET SNOMED=$PIECE(ZDATA,U,1)
+8 SET FNUM=51.2
+9 SET IENS=MEDIEN_","
+10 SET FDA=$NAME(FDA(FNUM,IENS))
+11 SET @FDA@(9999999.01)=SNOMED
+12 DO FILE^DIE("E","FDA","ERR")
End DoDot:1
+13 QUIT
