ABMDTFED ; IHS/ASDST/DMJ - REPORT OF 3P FEE SCHEDULES ;
;;2.6;IHS Third Party Billing System;**3,8,27**;NOV 12, 2009;Build 486
;
;IHS/SD/SDR 2.5*9 IM11865 - Made change so it will print to printer
;
;IHS/SD/SDR 2.6*3 FIXPMS10008 and FIXPMS10012 - Modified to not use templates and to print by
; effective dates that were introduced in patch 2.
;IHS/SD/SDR 2.6*27 CR8897 Fixed header when Charge Master selected; made NDC print for drugs; made sure
; display works with changes to IENs in 3P Fee Table
;
S U="^"
FEE W ! K DIC
S DIC="^ABMDFEE("
S DIC(0)="QEAM"
S DIC("A")="Select FEE SCHEDULE: "
S:$P($G(^ABMDPARM(DUZ(2),1,0)),U,9)]"" DIC("B")=$P(^(0),U,9)
D ^DIC
G XIT:$D(DUOUT)!$D(DTOUT)
I +Y<1 G FEE
S ABM("FEE")=+Y
SEL W !!,"======== FEE SCHEDULE CATEGORIES ========",!
K DIR
S (ABM("S"),DIR(0))="SO^1:MEDICAL;2:SURGICAL;3:RADIOLOGY;4:LABORATORY;5:ANESTHESIA;6:DENTAL;7:REVENUE CODE;8:HCPCS;9:DRUG;10:CHARGE MASTER"
S DIR("A")="Select Desired CATEGORY"
D ^DIR
G XIT:$D(DIROUT)!$D(DIRUT)
S ABM=+Y
S ABM("S")=$P($P($P(ABM("S"),U,2),";",+Y),":",2)
;start new code abm*2.6*3 FIXPMS10008
S:ABM("S")="MEDICAL" ABM("CAT")=19
S:ABM("S")="SURGICAL" ABM("CAT")=11
S:ABM("S")="RADIOLOGY" ABM("CAT")=15
S:ABM("S")="LABORATORY" ABM("CAT")=17
S:ABM("S")="ANESTHESIA" ABM("CAT")=23
S:ABM("S")="DENTAL" ABM("CAT")=21
S:ABM("S")="REVENUE CODE" ABM("CAT")=31
S:ABM("S")="HCPCS" ABM("CAT")=13
S:ABM("S")="DRUG" ABM("CAT")=25
S:ABM("S")="CHARGE MASTER" ABM("CAT")=32
;start new code abm*2.6*8 HEAT19236
W !,"Looking for effective dates..."
S ABMCODE=0
F S ABMCODE=$O(^ABMDFEE(ABM("FEE"),ABM("CAT"),ABMCODE)) Q:'ABMCODE D
.S ABMEFFDT=0
.F S ABMEFFDT=$O(^ABMDFEE(ABM("FEE"),ABM("CAT"),ABMCODE,1,"B",ABMEFFDT)) Q:'ABMEFFDT D
..S ABMELST(ABMEFFDT)=""
W !!,"Possible effective dates:"
S ABMEFFDT=0
F S ABMEFFDT=$O(ABMELST(ABMEFFDT)) Q:'ABMEFFDT W !?3,$$SDT^ABMDUTL(ABMEFFDT)
;end new code HEAT19236
D ^XBFMK
S DIR(0)="DA"
S DIR("A")="Use what effective date? "
D ^DIR
K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIROUT)
S ABM("EFFDT")=Y
;start old code abm*2.6*8 HEAT19236
;S ABM("TMP")=$O(^ABMDFEE(ABM("FEE"),1,"B",0))
;I (ABM("EFFDT")<($P(ABM("TMP"),".",1))) D G FEE
;.W !!?2,"The effective date you selected is before any effective date in this"
;.W !?2,"fee schedule."
;end old code HEAT19236
;end new code FIXPMS10008
;
W1 ;EP
W !!!
;start old code abm*2.6*8 HEAT26652
;S %ZIS="NQ"
;S %ZIS("B")=""
;D ^%ZIS
;G:'$D(IO)!$G(POP) XIT
;S ABM("ION")=ION
;G:$D(IO("Q")) QUE
;I IO'=IO(0),$E(IOST)'="C",'$D(IO("S")),$P($G(^ABMDPARM(DUZ(2),1,0)),U,13)="Y" W !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",! G QUE
;end old code start new code HEAT26652
S %ZIS="NQ"
S %ZIS("A")="Enter DEVICE: "
D ^%ZIS Q:POP
I IO'=IO(0) D QUE,HOME^%ZIS S DIR(0)="E" D ^DIR K DIR Q
I $D(IO("S")) S IOP=ION D ^%ZIS
;end new code HEAT26652
PRQUE ;EP - Entry Point for Taskman
S2 ;start old code abm*2.6*3 FIXPMS10008
;S L=0
;S DIC="^ABMDFEE("
;S FLDS="[ABMD TM "_ABM("S")_" FEES]"
;S BY=$S(ABM("S")="DENTAL":"[ABMD TM DENTAL FEE SCHEDULE]",1:"[ABMD TM FEE SCHEDULE]")
;S FR=$S(ABM("S")="DENTAL":ABM("FEE"),1:ABM("FEE"))
;S TO=$S(ABM("S")="DENTAL":ABM("FEE")_",?",1:ABM("FEE"))
;S IOP=ABM("ION")_";"_IOST_";"_80_";"_IOSL
;S PG=1
;D EN1^DIP
;end old code start new code FIXPMS10008
S ABM("PG")=0
S ABM("HD",0)=ABM("S")_" SERVICES FEE SCHEDULE"
S ABM("HD",1)="FEE SCHEDULE NUMBER "_ABM("FEE")_" WITH EFFECTIVE DATE "_$$SDT^ABMDUTL(ABM("EFFDT"))
K ^TMP("ABM-FS",$J)
D RANGE^ABMFEAPI(ABM("FEE"),ABM("CAT"),ABM("EFFDT"))
D HDB
S ABMCD=""
F S ABMCD=$O(^TMP("ABM-FS",$J,ABMCD)) Q:($G(ABMCD)="") D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S ABMCODE="",ABMDESC=""
.I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
.;I ABM("CAT")=25 S ABMCODE=$P($G(^PSDRUG($P($G(^TMP("ABM-FS",$J,ABMCD)),U),0)),U) ;drug ;abm*2.6*27 IHS/SD/SDR CR8894
.;start new abm*2.6*27 IHS/SD/SDR CR8894
.I ABM("CAT")=25 D
..S ABMCODE=$P($G(^PSDRUG($P($G(^TMP("ABM-FS",$J,ABMCD)),U),2)),U,4) ;NDC
..S ABMDESC=$P($G(^PSDRUG($P($G(^TMP("ABM-FS",$J,ABMCD)),U),0)),U) ;drug
.;end new abm*2.6*27 IHS/SD/SDR CR8894
.I ABM("CAT")=32 S ABMCODE=$P($G(^ABMCM(ABMCD,0)),U) ;charge master
.I (ABM("CAT")'=25&(ABM("CAT")'=32)) S ABMCODE=ABMCD
.;I "^19^11^15^17^23^13^"[("^"_ABM("CAT")_"^") S ABMDESC=$P($$CPT^ABMCVAPI($P(^TMP("ABM-FS",$J,ABMCD),U),ABM("EFFDT")),U,3) ;abm*2.6*27 IHS/SD/SDR CR8894
.;start new abm*2.6*27 IHS/SD/SDR CR8894
.I "^19^11^15^17^23^13^"[("^"_ABM("CAT")_"^") D
..S ABMDESC=$P($$CPT^ABMCVAPI(ABMCD,ABM("EFFDT")),U,3)
..I ABMDESC="" S ABMDESC=$P($$CPT^ABMCVAPI(ABMCD,DT),U,3)
.;end new abm*2.6*27 IHS/SD/SDR CR8894
.I ABM("CAT")=21 S ABMDESC=$P($G(^AUTTADA($P($G(^TMP("ABM-FS",$J,ABMCODE)),U),0)),U,2)
.I ABM("CAT")=31 S ABMDESC=$P($G(^AUTTREVN(ABMCD,0)),U,2)
.W !,ABMCODE
.;W ?10,$E(ABMDESC,1,32) ;abm*2.6*27 IHS/SD/SDR CR8894
.I ABM("CAT")'=25 W ?10 ;abm*2.6*27 IHS/SD/SDR CR8894
.I ABM("CAT")=25 W ?15 ;abm*2.6*27 IHS/SD/SDR CR8894
.W $E(ABMDESC,1,32) ;abm*2.6*27 IHS/SD/SDR CR8894
.I "^19^11^15^17^23^13^21^31^"[("^"_ABM("CAT")_"^") D
..W ?44,+$P($G(^TMP("ABM-FS",$J,ABMCD)),U,2)
..W ?56,+$P($G(^TMP("ABM-FS",$J,ABMCD)),U,3)
..W ?68,+$P($G(^TMP("ABM-FS",$J,ABMCD)),U,4)
.I "^19^11^15^17^23^13^21^31^"'[("^"_ABM("CAT")_"^") D
..I ABM("CAT")=25 Q ;abm*2.6*27 IHS/SD/SDR CR8894
..W ?44,+$P($G(^TMP("ABM-FS",$J,ABMCD)),U,2)
.I ABM("CAT")=25 W ?60,+$P($G(^TMP("ABM-FS",$J,ABMCD)),U,2) ;abm*2.6*27 IHS/SD/SDR CR8894
;end new code FIXPMS10008
XIT D ^%ZISC
K ABM
Q
;
QUE ;EP
;start old code abm*2.6*8
;K IO("Q")
;S ZTRTN="PRQUE^ABMDTFED"
;S ZTDESC="REPORT OF 3P FEE SCHEDULES"
;F ABM="ABM(" S ZTSAVE(ABM)=""
;D ^%ZTLOAD
;W:$D(ZTSK) !,"REQUEST QUEUED!",! G XIT
;end old code start new code
S ZTRTN="PRQUE^ABMDTFED"
S ZTDESC="REPORT OF 3P FEE SCHEDULES"
S ZTSAVE("ABM*")=""
K ZTSK
D ^%ZTLOAD
W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
Q
;end new code
;
;start new code abm*2.6*3 FIXPMS10008
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB S ABM("PG")=ABM("PG")+1
D WHD^ABMDRHD
;I "^19^11^15^17^23^13^21^31^"[("^"_ABM("CAT")_"^") W !?44,"GLOBAL",?56,"TECH",?68,"PROF" ;abm*2.6*27 IHS/SD/SDR CR8894
I "^19^11^15^17^23^13^21^31^32^"[("^"_ABM("CAT")_"^") W !?44,"GLOBAL",?56,"TECH",?68,"PROF" ;abm*2.6*27 IHS/SD/SDR CR8894
I "^19^11^15^17^23^13^"[("^"_ABM("CAT")_"^") W !,"CPT CODE",?10,"SHORT NAME",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
I ABM("CAT")=21 W !,"ADA CODE",?15,"SHORT NAME",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
;I ABM("CAT")=25 W !,"DRUG",?44,"PRICE PER DISPENSING UNIT" ;abm*2.6*27 IHS/SD/SDR CR8894
I ABM("CAT")=25 W !,"NDC",?18,"DRUG",?55,"PRICE PER DISPENSING UNIT" ;abm*2.6*27 IHS/SD/SDR CR8894
I ABM("CAT")=31 W !,"REV CODE",?10,"STANDARD ABBREV.",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
I ABM("CAT")=32 W !,"CHARGE MASTER",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
S $P(ABM("LINE"),"-",80)="" W !,ABM("LINE") K ABM("LINE")
Q
;end new code FIXPMS10008
ABMDTFED ; IHS/ASDST/DMJ - REPORT OF 3P FEE SCHEDULES ;
+1 ;;2.6;IHS Third Party Billing System;**3,8,27**;NOV 12, 2009;Build 486
+2 ;
+3 ;IHS/SD/SDR 2.5*9 IM11865 - Made change so it will print to printer
+4 ;
+5 ;IHS/SD/SDR 2.6*3 FIXPMS10008 and FIXPMS10012 - Modified to not use templates and to print by
+6 ; effective dates that were introduced in patch 2.
+7 ;IHS/SD/SDR 2.6*27 CR8897 Fixed header when Charge Master selected; made NDC print for drugs; made sure
+8 ; display works with changes to IENs in 3P Fee Table
+9 ;
+10 SET U="^"
FEE WRITE !
KILL DIC
+1 SET DIC="^ABMDFEE("
+2 SET DIC(0)="QEAM"
+3 SET DIC("A")="Select FEE SCHEDULE: "
+4 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,9)]""
SET DIC("B")=$PIECE(^(0),U,9)
+5 DO ^DIC
+6 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+7 IF +Y<1
GOTO FEE
+8 SET ABM("FEE")=+Y
SEL WRITE !!,"======== FEE SCHEDULE CATEGORIES ========",!
+1 KILL DIR
+2 SET (ABM("S"),DIR(0))="SO^1:MEDICAL;2:SURGICAL;3:RADIOLOGY;4:LABORATORY;5:ANESTHESIA;6:DENTAL;7:REVENUE CODE;8:HCPCS;9:DRUG;10:CHARGE MASTER"
+3 SET DIR("A")="Select Desired CATEGORY"
+4 DO ^DIR
+5 IF $DATA(DIROUT)!$DATA(DIRUT)
GOTO XIT
+6 SET ABM=+Y
+7 SET ABM("S")=$PIECE($PIECE($PIECE(ABM("S"),U,2),";",+Y),":",2)
+8 ;start new code abm*2.6*3 FIXPMS10008
+9 IF ABM("S")="MEDICAL"
SET ABM("CAT")=19
+10 IF ABM("S")="SURGICAL"
SET ABM("CAT")=11
+11 IF ABM("S")="RADIOLOGY"
SET ABM("CAT")=15
+12 IF ABM("S")="LABORATORY"
SET ABM("CAT")=17
+13 IF ABM("S")="ANESTHESIA"
SET ABM("CAT")=23
+14 IF ABM("S")="DENTAL"
SET ABM("CAT")=21
+15 IF ABM("S")="REVENUE CODE"
SET ABM("CAT")=31
+16 IF ABM("S")="HCPCS"
SET ABM("CAT")=13
+17 IF ABM("S")="DRUG"
SET ABM("CAT")=25
+18 IF ABM("S")="CHARGE MASTER"
SET ABM("CAT")=32
+19 ;start new code abm*2.6*8 HEAT19236
+20 WRITE !,"Looking for effective dates..."
+21 SET ABMCODE=0
+22 FOR
SET ABMCODE=$ORDER(^ABMDFEE(ABM("FEE"),ABM("CAT"),ABMCODE))
IF 'ABMCODE
QUIT
Begin DoDot:1
+23 SET ABMEFFDT=0
+24 FOR
SET ABMEFFDT=$ORDER(^ABMDFEE(ABM("FEE"),ABM("CAT"),ABMCODE,1,"B",ABMEFFDT))
IF 'ABMEFFDT
QUIT
Begin DoDot:2
+25 SET ABMELST(ABMEFFDT)=""
End DoDot:2
End DoDot:1
+26 WRITE !!,"Possible effective dates:"
+27 SET ABMEFFDT=0
+28 FOR
SET ABMEFFDT=$ORDER(ABMELST(ABMEFFDT))
IF 'ABMEFFDT
QUIT
WRITE !?3,$$SDT^ABMDUTL(ABMEFFDT)
+29 ;end new code HEAT19236
+30 DO ^XBFMK
+31 SET DIR(0)="DA"
+32 SET DIR("A")="Use what effective date? "
+33 DO ^DIR
+34 KILL DIR
+35 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DIROUT)
QUIT
+36 SET ABM("EFFDT")=Y
+37 ;start old code abm*2.6*8 HEAT19236
+38 ;S ABM("TMP")=$O(^ABMDFEE(ABM("FEE"),1,"B",0))
+39 ;I (ABM("EFFDT")<($P(ABM("TMP"),".",1))) D G FEE
+40 ;.W !!?2,"The effective date you selected is before any effective date in this"
+41 ;.W !?2,"fee schedule."
+42 ;end old code HEAT19236
+43 ;end new code FIXPMS10008
+44 ;
W1 ;EP
+1 WRITE !!!
+2 ;start old code abm*2.6*8 HEAT26652
+3 ;S %ZIS="NQ"
+4 ;S %ZIS("B")=""
+5 ;D ^%ZIS
+6 ;G:'$D(IO)!$G(POP) XIT
+7 ;S ABM("ION")=ION
+8 ;G:$D(IO("Q")) QUE
+9 ;I IO'=IO(0),$E(IOST)'="C",'$D(IO("S")),$P($G(^ABMDPARM(DUZ(2),1,0)),U,13)="Y" W !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",! G QUE
+10 ;end old code start new code HEAT26652
+11 SET %ZIS="NQ"
+12 SET %ZIS("A")="Enter DEVICE: "
+13 DO ^%ZIS
IF POP
QUIT
+14 IF IO'=IO(0)
DO QUE
DO HOME^%ZIS
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+15 IF $DATA(IO("S"))
SET IOP=ION
DO ^%ZIS
+16 ;end new code HEAT26652
PRQUE ;EP - Entry Point for Taskman
S2 ;start old code abm*2.6*3 FIXPMS10008
+1 ;S L=0
+2 ;S DIC="^ABMDFEE("
+3 ;S FLDS="[ABMD TM "_ABM("S")_" FEES]"
+4 ;S BY=$S(ABM("S")="DENTAL":"[ABMD TM DENTAL FEE SCHEDULE]",1:"[ABMD TM FEE SCHEDULE]")
+5 ;S FR=$S(ABM("S")="DENTAL":ABM("FEE"),1:ABM("FEE"))
+6 ;S TO=$S(ABM("S")="DENTAL":ABM("FEE")_",?",1:ABM("FEE"))
+7 ;S IOP=ABM("ION")_";"_IOST_";"_80_";"_IOSL
+8 ;S PG=1
+9 ;D EN1^DIP
+10 ;end old code start new code FIXPMS10008
+11 SET ABM("PG")=0
+12 SET ABM("HD",0)=ABM("S")_" SERVICES FEE SCHEDULE"
+13 SET ABM("HD",1)="FEE SCHEDULE NUMBER "_ABM("FEE")_" WITH EFFECTIVE DATE "_$$SDT^ABMDUTL(ABM("EFFDT"))
+14 KILL ^TMP("ABM-FS",$JOB)
+15 DO RANGE^ABMFEAPI(ABM("FEE"),ABM("CAT"),ABM("EFFDT"))
+16 DO HDB
+17 SET ABMCD=""
+18 FOR
SET ABMCD=$ORDER(^TMP("ABM-FS",$JOB,ABMCD))
IF ($GET(ABMCD)="")
QUIT
Begin DoDot:1
+19 SET ABMCODE=""
SET ABMDESC=""
+20 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE " (cont)"
+21 ;I ABM("CAT")=25 S ABMCODE=$P($G(^PSDRUG($P($G(^TMP("ABM-FS",$J,ABMCD)),U),0)),U) ;drug ;abm*2.6*27 IHS/SD/SDR CR8894
+22 ;start new abm*2.6*27 IHS/SD/SDR CR8894
+23 IF ABM("CAT")=25
Begin DoDot:2
+24 ;NDC
SET ABMCODE=$PIECE($GET(^PSDRUG($PIECE($GET(^TMP("ABM-FS",$JOB,ABMCD)),U),2)),U,4)
+25 ;drug
SET ABMDESC=$PIECE($GET(^PSDRUG($PIECE($GET(^TMP("ABM-FS",$JOB,ABMCD)),U),0)),U)
End DoDot:2
+26 ;end new abm*2.6*27 IHS/SD/SDR CR8894
+27 ;charge master
IF ABM("CAT")=32
SET ABMCODE=$PIECE($GET(^ABMCM(ABMCD,0)),U)
+28 IF (ABM("CAT")'=25&(ABM("CAT")'=32))
SET ABMCODE=ABMCD
+29 ;I "^19^11^15^17^23^13^"[("^"_ABM("CAT")_"^") S ABMDESC=$P($$CPT^ABMCVAPI($P(^TMP("ABM-FS",$J,ABMCD),U),ABM("EFFDT")),U,3) ;abm*2.6*27 IHS/SD/SDR CR8894
+30 ;start new abm*2.6*27 IHS/SD/SDR CR8894
+31 IF "^19^11^15^17^23^13^"[("^"_ABM("CAT")_"^")
Begin DoDot:2
+32 SET ABMDESC=$PIECE($$CPT^ABMCVAPI(ABMCD,ABM("EFFDT")),U,3)
+33 IF ABMDESC=""
SET ABMDESC=$PIECE($$CPT^ABMCVAPI(ABMCD,DT),U,3)
End DoDot:2
+34 ;end new abm*2.6*27 IHS/SD/SDR CR8894
+35 IF ABM("CAT")=21
SET ABMDESC=$PIECE($GET(^AUTTADA($PIECE($GET(^TMP("ABM-FS",$JOB,ABMCODE)),U),0)),U,2)
+36 IF ABM("CAT")=31
SET ABMDESC=$PIECE($GET(^AUTTREVN(ABMCD,0)),U,2)
+37 WRITE !,ABMCODE
+38 ;W ?10,$E(ABMDESC,1,32) ;abm*2.6*27 IHS/SD/SDR CR8894
+39 ;abm*2.6*27 IHS/SD/SDR CR8894
IF ABM("CAT")'=25
WRITE ?10
+40 ;abm*2.6*27 IHS/SD/SDR CR8894
IF ABM("CAT")=25
WRITE ?15
+41 ;abm*2.6*27 IHS/SD/SDR CR8894
WRITE $EXTRACT(ABMDESC,1,32)
+42 IF "^19^11^15^17^23^13^21^31^"[("^"_ABM("CAT")_"^")
Begin DoDot:2
+43 WRITE ?44,+$PIECE($GET(^TMP("ABM-FS",$JOB,ABMCD)),U,2)
+44 WRITE ?56,+$PIECE($GET(^TMP("ABM-FS",$JOB,ABMCD)),U,3)
+45 WRITE ?68,+$PIECE($GET(^TMP("ABM-FS",$JOB,ABMCD)),U,4)
End DoDot:2
+46 IF "^19^11^15^17^23^13^21^31^"'[("^"_ABM("CAT")_"^")
Begin DoDot:2
+47 ;abm*2.6*27 IHS/SD/SDR CR8894
IF ABM("CAT")=25
QUIT
+48 WRITE ?44,+$PIECE($GET(^TMP("ABM-FS",$JOB,ABMCD)),U,2)
End DoDot:2
+49 ;abm*2.6*27 IHS/SD/SDR CR8894
IF ABM("CAT")=25
WRITE ?60,+$PIECE($GET(^TMP("ABM-FS",$JOB,ABMCD)),U,2)
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+50 ;end new code FIXPMS10008
XIT DO ^%ZISC
+1 KILL ABM
+2 QUIT
+3 ;
QUE ;EP
+1 ;start old code abm*2.6*8
+2 ;K IO("Q")
+3 ;S ZTRTN="PRQUE^ABMDTFED"
+4 ;S ZTDESC="REPORT OF 3P FEE SCHEDULES"
+5 ;F ABM="ABM(" S ZTSAVE(ABM)=""
+6 ;D ^%ZTLOAD
+7 ;W:$D(ZTSK) !,"REQUEST QUEUED!",! G XIT
+8 ;end old code start new code
+9 SET ZTRTN="PRQUE^ABMDTFED"
+10 SET ZTDESC="REPORT OF 3P FEE SCHEDULES"
+11 SET ZTSAVE("ABM*")=""
+12 KILL ZTSK
+13 DO ^%ZTLOAD
+14 IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued.",!
+15 QUIT
+16 ;end new code
+17 ;
+18 ;start new code abm*2.6*3 FIXPMS10008
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
HDB SET ABM("PG")=ABM("PG")+1
+1 DO WHD^ABMDRHD
+2 ;I "^19^11^15^17^23^13^21^31^"[("^"_ABM("CAT")_"^") W !?44,"GLOBAL",?56,"TECH",?68,"PROF" ;abm*2.6*27 IHS/SD/SDR CR8894
+3 ;abm*2.6*27 IHS/SD/SDR CR8894
IF "^19^11^15^17^23^13^21^31^32^"[("^"_ABM("CAT")_"^")
WRITE !?44,"GLOBAL",?56,"TECH",?68,"PROF"
+4 IF "^19^11^15^17^23^13^"[("^"_ABM("CAT")_"^")
WRITE !,"CPT CODE",?10,"SHORT NAME",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
+5 IF ABM("CAT")=21
WRITE !,"ADA CODE",?15,"SHORT NAME",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
+6 ;I ABM("CAT")=25 W !,"DRUG",?44,"PRICE PER DISPENSING UNIT" ;abm*2.6*27 IHS/SD/SDR CR8894
+7 ;abm*2.6*27 IHS/SD/SDR CR8894
IF ABM("CAT")=25
WRITE !,"NDC",?18,"DRUG",?55,"PRICE PER DISPENSING UNIT"
+8 IF ABM("CAT")=31
WRITE !,"REV CODE",?10,"STANDARD ABBREV.",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
+9 IF ABM("CAT")=32
WRITE !,"CHARGE MASTER",?44,"CHARGE",?56,"CHARGE",?68,"CHARGE"
+10 SET $PIECE(ABM("LINE"),"-",80)=""
WRITE !,ABM("LINE")
KILL ABM("LINE")
+11 QUIT
+12 ;end new code FIXPMS10008
