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

ACRFNDF.m

Go to the documentation of this file.
  1. ACRFNDF ;IHS/OIRM/DSD/THL,AEF - NDF CONVERSION TO ARMS STANDARD ITEM FILE; [ 11/01/2001 9:44 AM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1. ;;ROUTINE TO CONVERT NATIONAL DRUG FILE TO ARMS STANDARD ITEM FILE
  1. EN D EN1
  1. EXIT K ACRQUIT
  1. K ACRVANAM,ACRV,ACRVANAM,ACRTNAM,ACRADMIN,ACRVPN
  1. Q
  1. EN1 S ACR="^PSNDF(""NDC"")"
  1. S ACRX="PSNDF(""NDC"""
  1. F S ACR=$Q(@ACR) Q:ACR=""!(ACR'[ACRX) D
  1. .S (ACRVANAM,ACRV,ACRVANAM,ACRTNAM,ACRADMIN,ACRVPN)=""
  1. .S DA=$P($P(ACR,",",9),")")
  1. .S ACRNDC=$P(ACR,",",2)
  1. .F ACRI=1:1:6 S DA(ACRI)=$P(ACR,",",ACRI+2)
  1. .I $D(^PSNDF(DA(1),2,DA(2),3,DA(3),4,DA(4),5,DA(5),6,DA(6),7,DA,0)) S ACRTNAM=$P(^(0),U,3),ACRVDA=$P(^(0),U,2),ACRADMIN=$P(^(0),U,5),ACRVPN=$P(^(0),U,4)
  1. .I ACRVDA,$D(^PS(55.95,ACRVDA,0)) S ACRV=$P(^(0),U)
  1. .I $D(^PSNDF(DA(1),0)) S ACRVANAM=$P(^(0),U)
  1. .I $D(^PSNDF(DA(1),5,ACRVPN,0)) S ACRVPN=$P(^(0),U)
  1. .W !!,ACRNDC
  1. .W ?20,"VA GENERIC NAME: ",ACRVANAM
  1. .W !?20,"VA PRODUCT NAME: ",ACRVPN
  1. .W !?20,"TRADE NAME.....: ",ACRTNAM
  1. .W !?20,"ADMINISTRATION.: ",ACRADMIN
  1. .W !?20,"VENDOR.........: ",ACRV
  1. Q