source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXDRUG.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1ECXDRUG ;BIR/DMA-Report of Drugs Missing Class or NDC ; 6/7/05 1:42pm
2 ;;3.0;DSS EXTRACTS;**8,84**;Dec 22, 1997
3 W @IOF,!!,"This routine will generate a list of drugs missing either VA Class or NDC.",!,"These two elements make up the feeder key for your drug products,",!,"and should be entered.",!!,"Note - supply items may not have an NDC",!!
4 S %ZIS="Q" D ^%ZIS K %ZIS Q:POP
5 I $D(IO("Q")) S ZTRTN="EN^ECXDRUG",ZTDESC="Report of drugs missing class or NDC" D ^%ZTLOAD,^%ZISC Q
6 ;
7EN ;entry point
8 N ARRAY,DR,A,A1,B,J,DIR,DIRUT,ECQ
9 S ARRAY="^TMP($J,""ECXLIST"")"
10 K @ARRAY
11 ;Call pharmacy drug file (#50) api dbia 4483 and create ^TMP global
12 D DATA^PSS50(,"??",DT,,,"ECXLIST")
13 D HEAD
14 S DR="" F S DR=$O(@ARRAY@("B",DR)) Q:DR=""!$D(ECQ) D
15 .F J=0 S J=$O(@ARRAY@("B",DR,J)) Q:'J!$D(ECQ) D
16 ..S A=@ARRAY@(J,.01)_U_^(2)_U_^(3),B=^(31)
17 ..I $P(A,U,2)=""!($P(A,U,3)["S")!(B="") D I $Y+5>IOSL D HEAD
18 ...W !,?5,$P(A,U) W:$P(A,U,2)="" ?50,"YES" W:B="" ?60,"YES" W:$P(A,U,3)["S" ?70,"YES"
19 K @ARRAY
20OUT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
21HEAD I IOST["C-" S DIR(0)="E" D ^DIR I 'Y S ECQ=1 Q
22 W:$Y @IOF W !,?25,"DRUG NAME",?48,"MISSING",?58,"MISSING",?68,"SUPPLY",!,?49,"CLASS",?60,"NDC",?69,"ITEM",! Q
23 ;
Note: See TracBrowser for help on using the repository browser.