APSPNDCR ;IHS/MSC/MGH - DRUG NDC REPORT ;14-Mar-2013 18:39;DU
;;7.0;IHS PHARMACY MODIFICATIONS;**1016**;Sep 23, 2004;Build 74
EN ;EP
N APSPNUM,APSPQ,APSPARY,APSPNAME,QFLG,APSPCNT
S APSPQ=""
;All or selection of drugs
W @IOF
W !,"Active Drug NDC Report",!!
S APSPNUM=$$DIR^APSPUTIL("S^A:All Drugs(this will be VERY LONG);U:Unmatched Drugs;N:Drugs with NO NDC code;M:Drugs with Mis-Matched codes","Type of Report? ",,,.APSPQ)
Q:APSPNUM=""
D DEV
Q
DEV ;EP
N XBRP,XBNS
S XBRP="OUT^APSPNDCR"
S XBNS="APS*"
D ^XBDBQUE
Q
OUT ;EP
N IEN,NODE,INACT,DRUG,INACTDT,NDC,VA,VANDC,VAIEN
U IO
D HDR
S IEN=0 F S IEN=$O(^PSDRUG(IEN)) Q:IEN=""!('+IEN) D
.S (VANDC,VA)=""
.S INACTDT=$$GET1^DIQ(50,IEN,100,"I")
.Q:+INACTDT
.S DRUG=$$GET1^DIQ(50,IEN,.01,"E")
.S NDC=$$GET1^DIQ(50,IEN,31)
.S NDC=$TR(NDC,"-","")
.S VAIEN=$$GET1^DIQ(50,IEN,22,"I")
.I VAIEN'="" D
..S VA=$$GET1^DIQ(50.68,VAIEN,.01)
..S VANDC=$$GET1^DIQ(50.68,VAIEN,13)
.I $L(VANDC)=12 S VANDC=$E(VANDC,2,12)
.I APSPNUM="A" D
..S APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
.I APSPNUM="U" D
..I VA="" S APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
.I APSPNUM="N" D
..I NDC=""&(VANDC="") S APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
.I APSPNUM="M" D
..I NDC'=""&(VANDC'="")&(NDC'=VANDC) S APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
S APSPQ=0
S DRUG="" F S DRUG=$O(APSPARY(DRUG)) Q:DRUG=""!(+APSPQ) D
.S NODE=$G(APSPARY(DRUG))
.S IEN=$P(NODE,U,1),NDC=$P(NODE,U,2),VA=$P(NODE,U,3),VANDC=$P(NODE,U,4)
.W !,IEN,?8,$E(DRUG,1,50),?58,NDC
.W !,?10,$E(VA,1,44),?58,VANDC,!
.I $Y+4>IOSL,IOST["C-" D PAUS Q:APSPQ D HDR
.Q:APSPQ=1
K APSPARY
Q
PAUS ;
N DTOUT,DUOUT,DIR
S DIR("?")="Enter '^' to Halt or Press Return to continue"
S DIR(0)="FO",DIR("A")="Press Return to continue or '^' to Halt"
D ^DIR
I $D(DUOUT) S APSPQ=1
Q
HDR ;
I IOST["C-" W @IOF
W !,"Active Drug NDC Report"
W !,"IEN",?8,"Drug Name",?58,"NDC"
W !,?10,"VA Product",?58,"VA NDC",!
Q
APSPNDCR ;IHS/MSC/MGH - DRUG NDC REPORT ;14-Mar-2013 18:39;DU
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1016**;Sep 23, 2004;Build 74
EN ;EP
+1 NEW APSPNUM,APSPQ,APSPARY,APSPNAME,QFLG,APSPCNT
+2 SET APSPQ=""
+3 ;All or selection of drugs
+4 WRITE @IOF
+5 WRITE !,"Active Drug NDC Report",!!
+6 SET APSPNUM=$$DIR^APSPUTIL("S^A:All Drugs(this will be VERY LONG);U:Unmatched Drugs;N:Drugs with NO NDC code;M:Drugs with Mis-Matched codes","Type of Report? ",,,.APSPQ)
+7 IF APSPNUM=""
QUIT
+8 DO DEV
+9 QUIT
DEV ;EP
+1 NEW XBRP,XBNS
+2 SET XBRP="OUT^APSPNDCR"
+3 SET XBNS="APS*"
+4 DO ^XBDBQUE
+5 QUIT
OUT ;EP
+1 NEW IEN,NODE,INACT,DRUG,INACTDT,NDC,VA,VANDC,VAIEN
+2 USE IO
+3 DO HDR
+4 SET IEN=0
FOR
SET IEN=$ORDER(^PSDRUG(IEN))
IF IEN=""!('+IEN)
QUIT
Begin DoDot:1
+5 SET (VANDC,VA)=""
+6 SET INACTDT=$$GET1^DIQ(50,IEN,100,"I")
+7 IF +INACTDT
QUIT
+8 SET DRUG=$$GET1^DIQ(50,IEN,.01,"E")
+9 SET NDC=$$GET1^DIQ(50,IEN,31)
+10 SET NDC=$TRANSLATE(NDC,"-","")
+11 SET VAIEN=$$GET1^DIQ(50,IEN,22,"I")
+12 IF VAIEN'=""
Begin DoDot:2
+13 SET VA=$$GET1^DIQ(50.68,VAIEN,.01)
+14 SET VANDC=$$GET1^DIQ(50.68,VAIEN,13)
End DoDot:2
+15 IF $LENGTH(VANDC)=12
SET VANDC=$EXTRACT(VANDC,2,12)
+16 IF APSPNUM="A"
Begin DoDot:2
+17 SET APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
End DoDot:2
+18 IF APSPNUM="U"
Begin DoDot:2
+19 IF VA=""
SET APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
End DoDot:2
+20 IF APSPNUM="N"
Begin DoDot:2
+21 IF NDC=""&(VANDC="")
SET APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
End DoDot:2
+22 IF APSPNUM="M"
Begin DoDot:2
+23 IF NDC'=""&(VANDC'="")&(NDC'=VANDC)
SET APSPARY(DRUG)=IEN_U_NDC_U_VA_U_VANDC
End DoDot:2
End DoDot:1
+24 SET APSPQ=0
+25 SET DRUG=""
FOR
SET DRUG=$ORDER(APSPARY(DRUG))
IF DRUG=""!(+APSPQ)
QUIT
Begin DoDot:1
+26 SET NODE=$GET(APSPARY(DRUG))
+27 SET IEN=$PIECE(NODE,U,1)
SET NDC=$PIECE(NODE,U,2)
SET VA=$PIECE(NODE,U,3)
SET VANDC=$PIECE(NODE,U,4)
+28 WRITE !,IEN,?8,$EXTRACT(DRUG,1,50),?58,NDC
+29 WRITE !,?10,$EXTRACT(VA,1,44),?58,VANDC,!
+30 IF $Y+4>IOSL
IF IOST["C-"
DO PAUS
IF APSPQ
QUIT
DO HDR
+31 IF APSPQ=1
QUIT
End DoDot:1
+32 KILL APSPARY
+33 QUIT
PAUS ;
+1 NEW DTOUT,DUOUT,DIR
+2 SET DIR("?")="Enter '^' to Halt or Press Return to continue"
+3 SET DIR(0)="FO"
SET DIR("A")="Press Return to continue or '^' to Halt"
+4 DO ^DIR
+5 IF $DATA(DUOUT)
SET APSPQ=1
+6 QUIT
HDR ;
+1 IF IOST["C-"
WRITE @IOF
+2 WRITE !,"Active Drug NDC Report"
+3 WRITE !,"IEN",?8,"Drug Name",?58,"NDC"
+4 WRITE !,?10,"VA Product",?58,"VA NDC",!
+5 QUIT
