- 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
