- 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
