| [613] | 1 | ECXDRUG ;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 | ;
|
|---|
| 7 | EN ;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
|
|---|
| 20 | OUT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 21 | HEAD 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 | ;
|
|---|
