ECXDRUG ;BIR/DMA-Report of Drugs Missing Class or NDC ; 6/7/05 1:42pm
;;3.0;DSS EXTRACTS;**8,84**;Dec 22, 1997
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",!!
S %ZIS="Q" D ^%ZIS K %ZIS Q:POP
I $D(IO("Q")) S ZTRTN="EN^ECXDRUG",ZTDESC="Report of drugs missing class or NDC" D ^%ZTLOAD,^%ZISC Q
;
EN ;entry point
N ARRAY,DR,A,A1,B,J,DIR,DIRUT,ECQ
S ARRAY="^TMP($J,""ECXLIST"")"
K @ARRAY
;Call pharmacy drug file (#50) api dbia 4483 and create ^TMP global
D DATA^PSS50(,"??",DT,,,"ECXLIST")
D HEAD
S DR="" F S DR=$O(@ARRAY@("B",DR)) Q:DR=""!$D(ECQ) D
.F J=0 S J=$O(@ARRAY@("B",DR,J)) Q:'J!$D(ECQ) D
..S A=@ARRAY@(J,.01)_U_^(2)_U_^(3),B=^(31)
..I $P(A,U,2)=""!($P(A,U,3)["S")!(B="") D I $Y+5>IOSL D HEAD
...W !,?5,$P(A,U) W:$P(A,U,2)="" ?50,"YES" W:B="" ?60,"YES" W:$P(A,U,3)["S" ?70,"YES"
K @ARRAY
OUT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
HEAD I IOST["C-" S DIR(0)="E" D ^DIR I 'Y S ECQ=1 Q
W:$Y @IOF W !,?25,"DRUG NAME",?48,"MISSING",?58,"MISSING",?68,"SUPPLY",!,?49,"CLASS",?60,"NDC",?69,"ITEM",! Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXDRUG 1228 printed Nov 22, 2024@17:02:36 Page 2
ECXDRUG ;BIR/DMA-Report of Drugs Missing Class or NDC ; 6/7/05 1:42pm
+1 ;;3.0;DSS EXTRACTS;**8,84**;Dec 22, 1997
+2 WRITE @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",!!
+3 SET %ZIS="Q"
DO ^%ZIS
KILL %ZIS
if POP
QUIT
+4 IF $DATA(IO("Q"))
SET ZTRTN="EN^ECXDRUG"
SET ZTDESC="Report of drugs missing class or NDC"
DO ^%ZTLOAD
DO ^%ZISC
QUIT
+5 ;
EN ;entry point
+1 NEW ARRAY,DR,A,A1,B,J,DIR,DIRUT,ECQ
+2 SET ARRAY="^TMP($J,""ECXLIST"")"
+3 KILL @ARRAY
+4 ;Call pharmacy drug file (#50) api dbia 4483 and create ^TMP global
+5 DO DATA^PSS50(,"??",DT,,,"ECXLIST")
+6 DO HEAD
+7 SET DR=""
FOR
SET DR=$ORDER(@ARRAY@("B",DR))
if DR=""!$DATA(ECQ)
QUIT
Begin DoDot:1
+8 FOR J=0
SET J=$ORDER(@ARRAY@("B",DR,J))
if 'J!$DATA(ECQ)
QUIT
Begin DoDot:2
+9 SET A=@ARRAY@(J,.01)_U_^(2)_U_^(3)
SET B=^(31)
+10 IF $PIECE(A,U,2)=""!($PIECE(A,U,3)["S")!(B="")
Begin DoDot:3
+11 WRITE !,?5,$PIECE(A,U)
if $PIECE(A,U,2)=""
WRITE ?50,"YES"
if B=""
WRITE ?60,"YES"
if $PIECE(A,U,3)["S"
WRITE ?70,"YES"
End DoDot:3
IF $Y+5>IOSL
DO HEAD
End DoDot:2
End DoDot:1
+12 KILL @ARRAY
OUT DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
HEAD IF IOST["C-"
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET ECQ=1
QUIT
+1 if $Y
WRITE @IOF
WRITE !,?25,"DRUG NAME",?48,"MISSING",?58,"MISSING",?68,"SUPPLY",!,?49,"CLASS",?60,"NDC",?69,"ITEM",!
QUIT
+2 ;
