ABMDRDR ; IHS/ASDST/DMJ - Drug File Report ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;03/25/96 11:32 AM
;
K ABM,ABMY S ABM("SYN")=0
W !!,"This program generates a listing of the Drug File, sorted in alphabetic order,",!,"showing the NDC Number and Dispense Fee of each drug.",!
K DIR S DIR(0)="Y",DIR("A")="Do you wish the Run the Program",DIR("B")="Y" D ^DIR K DIR G XIT:'Y
W ! K DIR S DIR(0)="Y",DIR("A")="Should the Listing display the Drug Synonyms",DIR("B")="N" D ^DIR K DIR G XIT:$D(DTOUT)!$D(DUOUT) S:Y ABM("SYN")=1
S ABM("HD",0)="",ABM("FAST")="" D HD^ABMDRHD
D ZIS^ABMDRUTL G XIT:$G(POP)
S ABM("HD",0)="DRUG FILE LISTING"
G:$D(IO("Q")) QUE
;
PRQUE ;EP - Entry Point for Taskman
S IOP=ABM("IOP") D ^%ZIS Q:$G(POP) U IO S ABM("PG")=0 D HDB
S ABM="" F S ABM=$O(^PSDRUG("B",ABM)) Q:ABM="" S ABM("D")=$O(^(ABM,0)) I $D(^PSDRUG(ABM("D"),0)) S ABM(0)=^(0),ABM(2)=$G(^(2)),ABM(6)=$G(^(660)) D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.W !,$P(ABM(0),U),?44,$P(ABM(2),U,4),?63,$J($FN($P(ABM(6),U,6),",",3),6),?75,$E($P(ABM(6),U,8),1,3)
.Q:'ABM("SYN")
.S ABM("S")=0 F S ABM("S")=$O(^PSDRUG(ABM("D"),1,ABM("S"))) Q:'ABM("S") S ABM(1)=^(ABM("S"),0) D
..S ABM("X")=$P(ABM(1),U) I ABM("X")="" K ABM("X") Q
..F ABM("%")=1:1:$L(ABM("X")) I $E(ABM("X"),ABM("%"))?1U,$E(ABM("X"),ABM("%")-1)?1A S ABM("X")=$E(ABM("X"),0,ABM("%")-1)_$C($A(ABM("X"),ABM("%"))+32)_$E(ABM("X"),ABM("%")+1,99)
.I $D(ABM("X")) W !?6,ABM("X") K ABM("X")
G XIT
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB W $$EN^ABMVDF("IOF") S ABM("PG")=ABM("PG")+1 D WHD^ABMDRHD
W !?60,"Dispense Fee"
W !?5,"Drug" W:ABM("SYN") " / Synonym" W ?45,"NDC Number",?62,"Per Unit",?74,"Units"
W !,"-------------------------------------------------------------------------------"
Q
;
XIT D POUT^ABMDRUTL,^%ZISC
Q
;
QUE S ZTRTN="PRQUE^ABMDRDR",ZTDESC="DRUG LISTING"
D QUE^ABMDRUTL
G XIT
ABMDRDR ; IHS/ASDST/DMJ - Drug File Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;03/25/96 11:32 AM
+3 ;
+4 KILL ABM,ABMY
SET ABM("SYN")=0
+5 WRITE !!,"This program generates a listing of the Drug File, sorted in alphabetic order,",!,"showing the NDC Number and Dispense Fee of each drug.",!
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish the Run the Program"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF 'Y
GOTO XIT
+7 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Should the Listing display the Drug Synonyms"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
IF Y
SET ABM("SYN")=1
+8 SET ABM("HD",0)=""
SET ABM("FAST")=""
DO HD^ABMDRHD
+9 DO ZIS^ABMDRUTL
IF $GET(POP)
GOTO XIT
+10 SET ABM("HD",0)="DRUG FILE LISTING"
+11 IF $DATA(IO("Q"))
GOTO QUE
+12 ;
PRQUE ;EP - Entry Point for Taskman
+1 SET IOP=ABM("IOP")
DO ^%ZIS
IF $GET(POP)
QUIT
USE IO
SET ABM("PG")=0
DO HDB
+2 SET ABM=""
FOR
SET ABM=$ORDER(^PSDRUG("B",ABM))
IF ABM=""
QUIT
SET ABM("D")=$ORDER(^(ABM,0))
IF $DATA(^PSDRUG(ABM("D"),0))
SET ABM(0)=^(0)
SET ABM(2)=$GET(^(2))
SET ABM(6)=$GET(^(660))
Begin DoDot:1
+3 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+4 WRITE !,$PIECE(ABM(0),U),?44,$PIECE(ABM(2),U,4),?63,$JUSTIFY($FNUMBER($PIECE(ABM(6),U,6),",",3),6),?75,$EXTRACT($PIECE(ABM(6),U,8),1,3)
+5 IF 'ABM("SYN")
QUIT
+6 SET ABM("S")=0
FOR
SET ABM("S")=$ORDER(^PSDRUG(ABM("D"),1,ABM("S")))
IF 'ABM("S")
QUIT
SET ABM(1)=^(ABM("S"),0)
Begin DoDot:2
+7 SET ABM("X")=$PIECE(ABM(1),U)
IF ABM("X")=""
KILL ABM("X")
QUIT
+8 FOR ABM("%")=1:1:$LENGTH(ABM("X"))
IF $EXTRACT(ABM("X"),ABM("%"))?1U
IF $EXTRACT(ABM("X"),ABM("%")-1)?1A
SET ABM("X")=$EXTRACT(ABM("X"),0,ABM("%")-1)_$CHAR($ASCII(ABM("X"),ABM("%"))+32)_$EXTRACT(ABM("X"),ABM("%")+1,99)
End DoDot:2
+9 IF $DATA(ABM("X"))
WRITE !?6,ABM("X")
KILL ABM("X")
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+10 GOTO XIT
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
HDB WRITE $$EN^ABMVDF("IOF")
SET ABM("PG")=ABM("PG")+1
DO WHD^ABMDRHD
+1 WRITE !?60,"Dispense Fee"
+2 WRITE !?5,"Drug"
IF ABM("SYN")
WRITE " / Synonym"
WRITE ?45,"NDC Number",?62,"Per Unit",?74,"Units"
+3 WRITE !,"-------------------------------------------------------------------------------"
+4 QUIT
+5 ;
XIT DO POUT^ABMDRUTL
DO ^%ZISC
+1 QUIT
+2 ;
QUE SET ZTRTN="PRQUE^ABMDRDR"
SET ZTDESC="DRUG LISTING"
+1 DO QUE^ABMDRUTL
+2 GOTO XIT
