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

BPBSUPD.m

Go to the documentation of this file. 
  1. BPBSUPD ;IHS/CIA/PLS - Update Drug File from AWP data ;10-Aug-2005 21:57;SM
  1.  ;;1.0;PHARMACY BARCODE SCAN;;August 10, 2005
  1.  ;=================================================================
  1. EN ;PEP - Called by the BPBS AWP SCAN BARCODE option
  1.  N DONE,APSPOP,TXT1,TXT2
  1.  I $$VERSION^XPDUTL("PSS")<1 D  Q
  1.  .W !,"This option requires the Pharmacy Data Management Package!"
  1.  D:'$D(PSOPAR) ^PSOLSET
  1.  D INIT
  1.  F  Q:$$LKUP(0)
  1.  ;
  1.  D FINAL^PSOLSET
  1.  Q
  1.  ;
  1. LKUP(BC) ;EP
  1.  N IEN,DATA,DRUG,DIC
  1.  N X,FDA,PSSZ,PSSFLAG,AIEN,APRMPT,DA
  1.  W !
  1.  S PSSZ=1,PSSFLAG=0
  1.  S IEN=$$GETIENA(50,"",-1,"","","QEALMNTV","",1)
  1.  Q:IEN<1 1
  1.  ;Q:'IEN 1
  1.  I IEN D
  1.  .S AIEN=$$GETNDC() Q:AIEN<0
  1.  .I 'AIEN D
  1.  ..S APRMPT="Would you like to manually update drug information"
  1.  ..S APRMPT(1)="A match cannot be found."
  1.  ..I $$DIRYN(.APRMPT,"Yes") D
  1.  ...D EDITDRG(1,IEN)
  1.  .E  D
  1.  ..; STUFF FIELDS
  1.  ..D DISPLAY(AIEN)
  1.  ..Q:'$$DIRYN("Do you want to update the Drug File","Yes")
  1.  ..D GETDATA(AIEN,.DATA),SETDATA(IEN,.DATA,.FDA)
  1.  ..D STORE(IEN,.FDA)
  1.  ..D EDITDRG(0,IEN)
  1.  .S IEN=0
  1.  Q 0
  1.  ;
  1. DISPLAY(IEN) ;EP
  1.  W !,"You have selected to edit the settings for the following drug:"
  1.  W !,?5,"Name : ",$$GET1^DIQ(9009037,IEN,201)
  1.  W !,?5,"NDC  : ",$$GET1^DIQ(9009037,IEN,.01)   ;,?25,"Pattern: ",$$GET1^DIQ(9009037,IEN,203)
  1.  W !,?5,"Manuf: ",$$GET1^DIQ(9009037,IEN,205)
  1.  ;W !,?7,"AWP Effective Date: ",$$FMTE^XLFDT($$GET1^DIQ(9009037,IEN,.02,"I"),"5Z")
  1.  W !,?5,"Dispense Units per Order: "_$$GET1^DIQ(9009037,IEN,103)
  1.  W !
  1.  Q
  1.  ; Find Drug File entry by NDC
  1. FINDDRG(NDC) ;EP
  1.  N ERR
  1.  Q $$FIND1^DIC(50,,,NDC,"ZNDC",,"ERR")
  1.  ; Get data from AWP File
  1. GETDATA(IEN,DATA) ;EP
  1.  N DRUG,ERR
  1.  S DATA(.01)=$$GET1^DIQ(9009037,IEN,.01)  ;NDC-UPC-HRI
  1.  S DATA(.02)=$$GET1^DIQ(9009037,IEN,.02,"I")  ;EFFECTIVE DATE
  1.  S DATA(.03)=$$GET1^DIQ(9009037,IEN,.03)  ;PER DISP UNIT
  1.  S DATA(.04)=$$GET1^DIQ(9009037,IEN,.04)  ;PER ORDER UNIT
  1.  S DATA(101)=$$GET1^DIQ(9009037,IEN,101)  ;PACKAGE SIZE
  1.  S DATA(102)=$$GET1^DIQ(9009037,IEN,102)  ;PACKAGE QUANTITY
  1.  S DATA(103)=$$GET1^DIQ(9009037,IEN,103)  ;DISP UNITS PER ORDER
  1.  ;S DATA(104)=$$GET1^DIQ(9009037,IEN,104)  ;
  1.  S DATA(201)=$$UP^XLFSTR($$TRIM^XLFSTR($$GET1^DIQ(9009037,IEN,201),"R"))  ;DRUG NAME
  1.  S DATA(205)=$$GET1^DIQ(9009037,IEN,205)  ;MANUFACTURER
  1.  S DATA(206)=$$GET1^DIQ(9009037,IEN,206)  ;GENERIC PRODUCT ID
  1.  S DATA(403)=$$GET1^DIQ(9009037,IEN,403)  ;AAC PER DISPENSE UNIT
  1.  S DATA(404)=$$GET1^DIQ(9009037,IEN,404)  ;AAC PER ORDER UNIT
  1.  Q
  1.  ; Set data into FDA Array
  1. SETDATA(DRUG,DATA,FDA) ;EP
  1.  N FN,SYN,NDC
  1.  S SYN=$$HASSYN(DRUG,DATA(201))
  1.  S FN=50,DRUG=DRUG_","
  1.  S NDC=DATA(.01)
  1.  ;S FDA(FN,DRUG,12)="" ; Order Unit
  1.  ;S FDA(FN,DRUG,3)=""  ; DEA
  1.  ;S FDA(FN,DRUG,14.5)=DATA(101)  ; WILL NOT BE USED
  1.  S FDA(FN,DRUG,31)=$E(NDC,1,5)_"-"_$E(NDC,6,9)_"-"_$E(NDC,10,11)
  1.  ;S FDA(FN,DRUG,15)=DATA(101)*DATA(102)
  1.  S FDA(FN,DRUG,15)=DATA(103)
  1.  S:DATA(.04)'="" FDA(FN,DRUG,9999999.31)=+DATA(.04)
  1.  S:DATA(.03)'="" FDA(FN,DRUG,9999999.32)=+DATA(.03)
  1.  S:DATA(.02) FDA(FN,DRUG,9999999.33)=DATA(.02)
  1.  S:DATA(403)'="" FDA(FN,DRUG,16)=DATA(403)
  1.  S:DATA(404)'="" FDA(FN,DRUG,13)=DATA(404)
  1.  S:'SYN FDA(FN+.1,"?+1,"_DRUG,.01)=DATA(201)  ; Drug Name
  1.  S FDA(FN+.1,$S(SYN:SYN,1:"?+1")_","_DRUG,1)=0    ; Trade Name
  1.  S FDA(FN+.1,$S(SYN:SYN,1:"?+1")_","_DRUG,2)=DATA(.01)    ; NDC-UPC-HRI
  1.  S:DATA(205)'="" FDA(FN+.1,$S(SYN:SYN,1:"?+1")_","_DRUG,405)=DATA(205)
  1.  Q
  1.  ;
  1.  ; Commit updates to File 50.
  1. STORE(DRUG,FDA,NEW) ;EP
  1.  N MSG
  1.  W !,?5,"Applying updates..."
  1.  S NEW=$G(NEW,1)
  1.  I NEW D
  1.  .D UPDATE^DIE(,"FDA",,"MSG")
  1.  E  D
  1.  .D FILE^DIE("K","FDA","MSG")
  1.  I $D(MSG) D
  1.  .W !,"The following error occurred:"
  1.  .W !,$G(MSG("DIERR",1,"TEXT",1))
  1.  E  W !,?5,"Updates are complete..."
  1.  K FDA
  1.  Q
  1.  ; Prompt for entry from file (Calls MIX^DIC1)
  1.  ; APSFILE = File #
  1.  ; APSPMPT = Prompt
  1.  ; APSDFLD = Field whose value is to be used for default value
  1.  ;           Set to -1 for no default value
  1.  ; D = x-ref (C^D)
  1.  ; APSSCRN = DIC("S") SCREEN LOGIC
  1.  ; APSDIC0 = Parameters for DIC(0)
  1.  ; APSLYFLD = List of forced identifier fields (DR) to override the defaulted fields.
  1. GETIEN(APSFILE,APSPMPT,APSDFLD,D,APSSCRN,APSDIC0,APSLYFLD) ;EP
  1.  N DIC,APSD,Y,DA
  1.  S D=$G(D,"B")
  1.  S:'$L(D) D="B"
  1.  S DIC(0)=$G(APSDIC0,"AE")
  1.  S APSDFLD=$G(APSDFLD,.01)
  1.  S APSD=""
  1.  S DIC("S")=$G(APSSCRN)
  1.  S:APSDFLD>0 APSD=$$GET1^DIQ(APSFILE,$$FIND1^DIC(APSFILE,,," ",.D,DIC("S")),APSDFLD)
  1.  S DIC=APSFILE
  1.  S DIC("A")=$G(APSPMPT),DIC("B")=APSD
  1.  I $L(D,U)>1,DIC(0)'["M" S DIC(0)=DIC(0)_"M"
  1.  I DIC(0)["L" S DIC("DR")=$G(APSLYFLD)  ; Set force identifiers to inputted list
  1.  D MIX^DIC1
  1.  Q $S($D(DTOUT)!($D(DUOUT)):-1,+Y>0:+Y,1:0)
  1.  ;
  1.  ; Prompt for entry from file (calls ^DIC)
  1.  ; APSFILE = File #
  1.  ; APSPMPT = Prompt
  1.  ; APSDFLD = Field whose value is to be used for default value
  1.  ;           Set to -1 for no default value
  1.  ; D = x-ref (C^D)
  1.  ; APSSCRN = DIC("S") SCREEN LOGIC
  1.  ; APSDIC0 = Parameters for DIC(0)
  1.  ; APSLYFLD = List of forced identifier fields (DR) to override the defaulted fields.
  1.  ; EVRYREC = If defined, will set DIC("T")
  1. GETIENA(APSFILE,APSPMPT,APSDFLD,D,APSSCRN,APSDIC0,APSLYFLD,EVRYREC) ;EP
  1.  N DIC,APSD,Y,DA,DUOUT,DTOUT
  1.  S DIC(0)=$G(APSDIC0,"AE")
  1.  S APSDFLD=$G(APSDFLD,.01)
  1.  S APSD=""
  1.  S:$L($G(APSSCRN)) DIC("S")=$G(APSSCRN)
  1.  S:APSDFLD>0 APSD=$$GET1^DIQ(APSFILE,$$FIND1^DIC(APSFILE,,," ",.D,DIC("S")),APSDFLD)
  1.  S DIC=APSFILE
  1.  S:$G(EVRYREC) DIC("T")=""
  1.  S DIC("A")=$G(APSPMPT),DIC("B")=APSD
  1.  I DIC(0)["L" S DIC("DR")=$G(APSLYFLD)  ; Set force identifiers to inputted list
  1.  D ^DIC
  1.  Q $S($D(DTOUT)!($D(DUOUT)):-1,+Y>0:+Y,1:0)
  1.  ;
  1. GETNDC() ;EP
  1.  N IEN,UPC,ERR,NDC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,Y
  1.  S DIR("A")="Scan or enter UPC/NDC Value"
  1.  S DIR("A",1)="Format: NDC Value(5-4-2 format, no dashes)"
  1.  S DIR("A",2)="        UPC Value(Full barcode number)"
  1.  S DIR("?")="The value must be between 11 and 14 numbers and not contain a '-'."
  1.  S DIR(0)="FO^11:14^K:X'?11N.N X"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT)) -1
  1.  S UPC=Y
  1.  Q:UPC="" 0
  1.  I $L(UPC)>11 D  ; A UPC code was scanned.
  1.  .S NDC=$E(UPC,$L(UPC)-10,$L(UPC)-1)
  1.  .I $E(NDC,1) S NDC=$E(NDC,1,5)_"0"_$E(NDC,6,10)
  1.  .E  S NDC="0"_NDC
  1.  E  D  ; A NDC was manually entered
  1.  .S NDC=$E(UPC,1,11)
  1.  S IEN=$$FIND1^DIC(9009037,,,NDC,,,"ERR")
  1.  Q IEN
  1.  ;
  1. FMTNDC(NDC) ;EP
  1.  ;Q:NDC["-" NDC
  1.  I $E(NDC,1) S NDC=$E(NDC,1,5)_"-0"_$E(NDC,6,8)_"-"_$E(NDC,9,10)
  1.  E  S NDC="0"_$E(NDC,1,4)_"-"_$E(NDC,5,8)_"-"_$E(NDC,9,10)
  1.  Q NDC
  1.  ; DIR call for Y/N response
  1. DIRYN(APSPMT,APSDFL,APSHLP,APSPOP) ;EP
  1.  N Y
  1.  S Y=$$DIR("YO",.APSPMT,.APSDFL,.APSHLP,.APSPOP)
  1.  Q Y
  1.  ;
  1.  ; Parameterized DIR call
  1. DIR(APSDTP,APSPMT,APSDFL,APSHLP,APSPOP,APSSCRN) ;EP
  1.  N DIR,DTOUT,DUOUT,Y
  1.  S DIR(0)=APSDTP
  1.  S:$L($G(APSDFL)) DIR("B")=$G(APSDFL)
  1.  I '$G(APSPMT) M DIR("A")=APSPMT
  1.  I '$G(APSHLP) M DIR("?")=APSHLP
  1.  S DIR("S")=$G(APSSCRN,"")
  1.  I $G(APSKDIRB) K DIR("B")
  1.  D ^DIR
  1.  S:$D(DUOUT)!$D(DTOUT) APSPOP=1
  1.  Q Y
  1.  ; Pause for user input
  1. DIRZ(APSPMT) ;EP
  1.  N X
  1.  S X=$$DIR("E",.APSPMT,,,.APSPOP)
  1.  Q
  1.  ; Return AWP Drug Name
  1. GAWPDNM(DRGIEN) ;EP
  1.  Q $$GET1^DIQ(9009037,DRGIEN,201)
  1.  ; Return Synonym IEN
  1. HASSYN(DRGIEN,SYN) ;EP
  1.  N RES,LP
  1.  S RES=0
  1.  I DRGIEN,$L(SYN) D
  1.  .S LP=0 F  S LP=$O(^PSDRUG(DRGIEN,1,LP)) Q:'LP  D  Q:RES
  1.  ..I $P(^PSDRUG(DRGIEN,1,LP,0),U)=SYN S RES=LP
  1.  Q RES
  1.  ; Edit Drug File entry
  1. EDITDRG(MANUAL,DRUG) ;EP
  1.  S MANUAL=$G(MANUAL,1)
  1.  D PSSMAN^BPBSUPD1(MANUAL,DRUG)
  1.  Q
  1.  ; Setup
  1. INIT ;EP
  1.  S TXT1="Unable to locate drug for NDC"
  1.  S TXT2="Please manually enter the NDC number in 5-4-2 format(NO DASHES)."
  1.  S TXT3="Do you wish to manually enter drug information"
  1.  Q
  1.  ;
  1. T1 ;EP
  1.  N PRMPT
  1.  S PRMPT="Would you like to manually update the Drug File"
  1.  S PRMPT(1)="A match cannot be found!"
  1.  W $$DIRYN(.PRMPT,"Yes")
  1.  Q