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

PSNLOOK.m

Go to the documentation of this file. 
  1. PSNLOOK ;BIR/WRT-Look up into drug file ; 06/19/03 15:00
  1.  ;;4.0;NATIONAL DRUG FILE;**2,3,5,11,22,27,62,70,169,262,296,429,492,396**; 30 Oct 98;Build 190
  1.  ;
  1.  ; Reference to ^PSDRUG supported by DBIA# 2192
  1.  ; Reference to ^PS(50.606 supported by DBIA# 2174
  1.  ; Reference to ^PSNAPIS supported by DBIA #2531
  1.  ;
  1.  ;USE PSNLK*
  1. BEGIN ;
  1.  D ASK
  1.  N PSNLKDA,PSNLKIND,PSNLKCL,PSNLKNOD,PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR,PSNLKDAV,PSNLKGK,PSNLKPMI,PSNLKQQ
  1.  N DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIR,DIRUT,DIROUT,%DT,PSNLKMAP,PSNLKENG,PSNLKDF,PSNLKSTR,PSNLKUN,PSNLKFRM
  1.  N PSNLKUNT,PSNLKNFN,PSNLKBB,PSNLKAND,PSNLKGR,PSNLKIST,PSNLKIUT,PSNLKSEV,PSNLKCSF,PSNLKSP,PSNLKNND,PSNLKCC
  1.  N PSNLKSCL,PSNLKZ,PSNLKRE,PSNLKWRT,PSNZZFS,PSNLKL1,PSNLKL2,PSNLKIUN,PSNZZFSA,PSNLKCP,PSNTDRUG
  1. SELD ;Select Drug
  1.  K PSNLKDA,PSNLKIND,PSNLKCL,PSNLKNOD,PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR,PSNLKDAV,PSNLKGK,PSNLKPMI,PSNLKQQ
  1.  K DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIR,DIRUT,DIROUT,%DT,PSNLKMAP,PSNLKENG,PSNLKDF,PSNLKSTR,PSNLKUN,PSNLKFRM
  1.  K PSNLKUNT,PSNLKNFN,PSNLKBB,PSNLKAND,PSNLKGR,PSNLKIST,PSNLKIUT,PSNLKSEV,PSNLKCSF,PSNLKSP,PSNLKNND,PSNLKCC
  1.  K PSNLKSCL,PSNLKZ,PSNLKRE,PSNLKWRT,PSNZZFS,PSNLKL1,PSNLKL2,PSNLKIUN,PSNZZFSA,PSNLKCP,PSNFD,PSNFDT
  1.  W ! K DIC S DIC=50,DIC(0)="QEAM",DIC("W")="S PSNTDRUG=Y D GETTIER^PSNLOOK(PSNTDRUG)" D ^DIC I Y<0!($D(DTOUT))!($D(DUOUT)) Q
  1.  S PSNLKDA=+Y K Y
  1.  S PSNLKIND=$P($G(^PSDRUG(PSNLKDA,"I")),"^") I PSNLKIND,PSNLKIND<DT  S Y=PSNLKIND D DD^%DT W !!,"This drug has an Inactive date of "_$G(Y),! D MESS G SELD
  1.  D DSPLY
  1.  D HG
  1.  G SELD
  1.  ;
  1. ASK W !!,"This option will allow you to look up entries in your local DRUG file. It will",!,"display National Drug File software match information.",!
  1.  Q
  1. DSPLY W @IOF W !?14,"DRUG Generic Name:  ",$P($G(^PSDRUG(PSNLKDA,0)),"^") I $D(^PSDRUG(PSNLKDA,"ND")) S PSNLKCL=$P(^("ND"),"^",6)
  1.  I $D(^PSDRUG(PSNLKDA,"ND")),$P(^PSDRUG(PSNLKDA,"ND"),"^",2)]"" S PSNLKNOD=^PSDRUG(PSNLKDA,"ND") D DSPLY1,DSPLY2,PRODF,DSP,ING,SV,DSP1,RESTN Q
  1.  W !?8,"*** NO NATIONAL DRUG FILE INFORMATION ***",!
  1.  Q
  1. DSPLY1 W !?5,"VA Product Name: ",$P(PSNLKNOD,"^",2)
  1.  W !?5,"VA Generic Name: ",$P($G(^PSNDF(50.6,$P(PSNLKNOD,"^"),0)),"^")
  1.  Q
  1. DSPLY2 ;
  1.  S (PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR)=""
  1.  K X S PSNLKDAV=$P(PSNLKNOD,"^"),PSNLKGK=$P(PSNLKNOD,"^",3),X=$$PROD2^PSNAPIS(PSNLKDAV,PSNLKGK) I $P(X,"^")]"" S PSNLKVPN=$P(X,"^"),PSNLKID=$P(X,"^",2),PSNLKTR=$P(X,"^",3),PSNLKVDU=$P(X,"^",4)
  1.  K PSNLKPMI I X]"" S PSNLKQQ=$P(^PSNDF(50.68,PSNLKGK,1),"^",5) D GCN
  1.  K X
  1.  Q
  1. GCN I PSNLKQQ']"" S PSNLKPMI="None" Q
  1.  ;
  1. GCN1 ; 
  1.  I $D(^PS(50.623,"B",PSNLKQQ)) S PSNLKMAP=$O(^PS(50.623,"B",PSNLKQQ,0)),PSNLKENG=$P(^PS(50.623,PSNLKMAP,0),"^",2),PSNLKPMI=$P(^PS(50.621,+PSNLKENG,0),"^") Q
  1.  S PSNLKPMI="None"
  1.  Q
  1. DSPLY3 W ?50,"Transmit To CMOP: "
  1.  I PSNLKTR=1 W "YES"
  1.  I PSNLKTR=0 W "NO"
  1.  Q
  1. PRODF ;
  1.  S X=$$PROD0^PSNAPIS(PSNLKDAV,PSNLKGK)
  1.  S PSNLKDF=+$P(X,"^",2),PSNLKSTR=$P(X,"^",3),PSNLKUN=+$P(X,"^",4),PSNLKFRM=$S($G(PSNLKDF):$P($G(^PS(50.606,PSNLKDF,0)),"^"),1:""),PSNLKUNT=$S($G(PSNLKUN):$P($G(^PS(50.607,PSNLKUN,0)),"^"),1:""),PSNLKNFN=$P(^PSNDF(50.68,PSNLKGK,0),"^",6)
  1.  K X
  1.  Q
  1. ING F PSNLKBB=0:0 S PSNLKBB=$O(^PSNDF(50.68,PSNLKGK,2,PSNLKBB)) Q:'PSNLKBB  D
  1.  .I $D(^PSNDF(50.68,PSNLKGK,2,PSNLKBB,0)) S PSNLKAND=$G(^PSNDF(50.68,PSNLKGK,2,PSNLKBB,0)),PSNLKGR=$P(^PS(50.416,$P(PSNLKAND,"^",1),0),"^"),PSNLKIST=$P(PSNLKAND,"^",2),PSNLKIUT=$P(PSNLKAND,"^",3) K PSNLKIUN D ING1,IN2
  1.  Q
  1. IN2 W ?3,PSNLKGR,?50,"Str: ",PSNLKIST W:PSNLKIUT ?65,"Unt: ",$G(PSNLKIUN) W !
  1.  Q
  1. ING1 S:$P(^PS(50.416,$P(PSNLKAND,"^"),0),"^",2) PSNLKGR=$P($G(^PS(50.416,$P(^PS(50.416,$P(PSNLKAND,"^"),0),"^",2),0)),"^") I PSNLKIUT S PSNLKIUN=$P(^PS(50.607,PSNLKIUT,0),"^")
  1.  Q
  1. SC I $O(^PSNDF(50.68,PSNLKGK,4,0)) W !,"Secondary Class(es): ",! F PSNLKCC=0:0 S PSNLKCC=$O(^PSNDF(50.68,PSNLKGK,4,PSNLKCC)) Q:'PSNLKCC  S PSNLKZ=$P($G(^PSNDF(50.68,PSNLKGK,4,PSNLKCC,0)),"^") I PSNLKZ D
  1.  .S PSNLKSCL=$P($G(^PS(50.605,PSNLKZ,0)),"^") D SC1
  1.  Q
  1. SC1 W "   ",PSNLKSCL
  1.  Q
  1. SV S PSNLKSEV=$G(^PSNDF(50.68,PSNLKGK,7)) I PSNLKSEV]"" S PSNLKCSF=$P(PSNLKSEV,"^"),PSNLKSP=$P(PSNLKSEV,"^",2) S:PSNLKSP="M" PSNLKSP="Multi" S:PSNLKSP="S" PSNLKSP="Single" D SV1
  1.  Q
  1. SV1 S PSNZZFSA=PSNLKGK_"," S PSNZZFS=$$GET1^DIQ(50.68,PSNZZFSA,19) I $G(PSNZZFS)="" S PSNZZFS="None"
  1.  S PSNLKNND=$P(^PSNDF(50.68,PSNLKGK,7),"^",3)
  1.  Q
  1. DSP W !,"Dosage Form: ",PSNLKFRM_$S('$G(PSNLKDF):"",$P($G(^PS(50.606,PSNLKDF,1)),"^")=1:"  (Exclude from Dosing Cks)",1:"")
  1.  S PSNLKL1=$L(PSNLKSTR),PSNLKL2=$S($G(PSNLKUN):$L(PSNLKUNT),1:0)
  1.  I (PSNLKL1+PSNLKL2)<62 W !,"Strength: ",PSNLKSTR W:$G(PSNLKUN) " Units: "_PSNLKUNT G PSDZZ
  1.  W !,"Strength: ",PSNLKSTR
  1.  I $G(PSNLKUN) D
  1.  .W !,"Units: " I PSNLKL2<72 W PSNLKUNT Q
  1.  .W !,PSNLKUNT
  1. PSDZZ ;
  1.  W !,"National Formulary Name: ",PSNLKNFN,!,"VA Print Name: ",PSNLKVPN,!,"VA Product Identifier: ",PSNLKID D DSPLY3 W !,"VA Dispense Unit: ",PSNLKVDU I $D(PSNLKPMI) W !,"PMIS: ",PSNLKPMI
  1.  W !,"Active Ingredients: ",!
  1.  Q
  1. DSP1 D HG W "Primary Drug Class: ",$P(^PS(50.605,PSNLKCL,0),"^") D SC W !,"CS Federal Schedule: ",$G(PSNLKCSF)_"  "_$G(PSNZZFS),!,"Single/Multi Source Product: ",$G(PSNLKSP)
  1.  I $G(PSNLKNND)]"" W !,"Inactivation Date: " S Y=PSNLKNND D DD^%DT W Y K Y
  1.  W !,"Max Single Dose: ",$P(PSNLKSEV,"^",4),?45,"Min Single Dose: ",$P(PSNLKSEV,"^",5)
  1.  W !,"Max Daily Dose: ",$P(PSNLKSEV,"^",6),?45,"Min Daily Dose: ",$P(PSNLKSEV,"^",7),!,"Max Cumulative Dose: ",$P(PSNLKSEV,"^",8)
  1.  W !,"National Formulary Indicator: " I $D(^PSNDF(50.68,PSNLKGK,5)) W:$P(^PSNDF(50.68,PSNLKGK,5),"^")=0 "No" W:$P(^PSNDF(50.68,PSNLKGK,5),"^")=1 "Yes"
  1.  D FD^PSNACT(PSNLKGK),FDT^PSNACT(PSNLKGK) ;ppsn
  1.  N CPDATE,X D NOW^%DTC S CPDATE=X S PSNLKCP=$$CPTIER^PSNAPIS(PSNLKGK,CPDATE,"",1) K CPDATE,X
  1.  ;  PSNLKCP = Copay Tier^Effective Date^End Date
  1.  W !,"Copay Tier: ",$P(PSNLKCP,"^",1)
  1.  W !,"Copay Effective Date: " S Y=$P(PSNLKCP,"^",2) D DD^%DT W Y K Y
  1.  W !
  1.  I $G(^PSNDF(50.68,PSNLKGK,8)) W !,"Exclude Drg-Drg Interaction Ck: Yes (No check for Drug-Drug Interactions)"
  1.  D OVER
  1.  D:$Y>18 HG
  1.  ;CLINICAL EFFECTS
  1.  W !
  1.  D CLEFF^PSNCLEHW(PSNLKGK)  D:$Y>18 HG
  1.  W !
  1.  D POSDOS^PSNACT(PSNLKGK)
  1.  W !,"Maximum Days Supply: ",$$GET1^DIQ(50.68,PSNLKGK,32)
  1.  ;HAZ WASTE
  1.  D:$Y>20 HG
  1.  D HAZWASTE^PSNCLEHW(PSNLKGK)
  1.  N I,J,PSNCODX,PSNCODJ,PSNRXCUI S PSNCODX=0
  1.  F I=1:1 S PSNCODX=$O(^PSNDF(50.68,PSNLKGK,11,PSNCODX)) Q:PSNCODX="B"!(PSNCODX="")  D
  1.  . S PSNRXCUI=$G(^PSNDF(50.68,PSNLKGK,11,PSNCODX,0)) Q:PSNRXCUI'="RxNorm"
  1.  . W !!,"Coding System: ",$P(^PSNDF(50.68,PSNLKGK,11,PSNCODX,0),"^",1) S PSNCODJ=0
  1.  . F J=1:1 S PSNCODJ=$O(^PSNDF(50.68,PSNLKGK,11,PSNCODX,1,PSNCODJ)) Q:PSNCODJ="B"!(PSNCODJ="")  D
  1.  .. W !,"Code: ",$P(^PSNDF(50.68,PSNLKGK,11,PSNCODX,1,PSNCODJ,0),"^",1)
  1.  W !
  1.  Q
  1. RESTN I $O(^PSNDF(50.68,PSNLKGK,6,0)) W !,"Restriction: " F PSNLKRE=0:0 S PSNLKRE=$O(^PSNDF(50.68,PSNLKGK,6,PSNLKRE)) Q:'PSNLKRE  S PSNLKWRT=$G(^PSNDF(50.68,PSNLKGK,6,PSNLKRE,0)) W !,PSNLKWRT
  1.  Q
  1. HG ;
  1.  W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
  1.  W @IOF
  1.  Q
  1. MESS ;
  1.  W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
  1.  Q
  1.  ;
  1. OVER ;
  1.  W !,"Override DF Exclude from Dosage Checks: "_$S($P($G(^PSNDF(50.68,PSNLKGK,9)),"^")=1:"Yes",$P($G(^PSNDF(50.68,PSNLKGK,9)),"^")=0:"No",1:"") I $P($G(^PSNDF(50.68,PSNLKGK,9)),"^")=1 D
  1.  .I '$G(PSNLKDF) Q
  1.  .I '$D(^PS(50.606,PSNLKDF,0)) Q
  1.  .I $P($G(^PS(50.606,PSNLKDF,1)),"^")=1 W " (Dosage Checks shall be performed)" Q
  1.  .I $P($G(^PS(50.606,PSNLKDF,1)),"^")=0 W " (No Dosage Checks performed)"
  1.  Q
  1.  ;
  1. GETTIER(PSNTDRUG) ;called by DIC; look up copay tier by file 50 ien for current date
  1.  N VAPID,CPDATE,X,PSSCP,VAPROD,PSNINACT,PSNCONVD,PSNFD
  1.  S VAPROD=$$GET1^DIQ(50,PSNTDRUG,22,"I")
  1.  S PSNFD=$$GET1^DIQ(50.68,VAPROD,109)
  1.  W:PSNFD'="" " "_PSNFD
  1.  Q:'$G(VAPROD)
  1.  D NOW^%DTC S CPDATE=$P(%,".")
  1.  S PSSCP=$$CPTIER^PSNAPIS(VAPROD,CPDATE,PSNTDRUG,1) K CPDATE,X
  1.  I $P(PSSCP,"^")'="" W " Tier ",$P(PSSCP,"^")
  1.  S PSNINACT=$$GET1^DIQ(50,PSNTDRUG,100,"I")  ;inactive date
  1.  S:$G(PSNINACT) PSNCONVD=$$DATE(PSNINACT)
  1.  W:$G(PSNCONVD)'="" "  "_PSNCONVD
  1.  Q
  1.  ;
  1. DATE(PSNCONVD) ;convert fileman date to mm/dd/yyyy
  1.  N DATE
  1.  S DATE="",DATE=$E(PSNCONVD,4,5)_"/"_$E(PSNCONVD,6,7)_"/"_(1700+$E(PSNCONVD,1,3))
  1.  Q DATE