ABMDE8H ; IHS/ASDST/DMJ - Page 8 - MISC INFO ;
;;2.6;IHS 3P BILLING SYSTEM;**6,23**;NOV 12, 2009;Build 427
;
;IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190
; Modified to display 2nd and 3rd modifiers and units
;IHS/SD/SDR - V2.5 P8 - IM16018/IM11164 - Prompt/display provider
;IHS/SD/SDR - v2.5 p9 - IM16660 - 4-digit revenue codes
;IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple
;IHS/SD/SDR - v2.5 p10 - IM20454 - Fixed so 2nd and 3rd modifiers would be prompted for
;IHS/SD/SDR - v2.5 p10 - IM19843 - Added new prompt SERVICE TO DATE/TIME
;IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - abm*2.6*6 - 5010 - Added prompts for DME billing fields
;IHS/SD/AML 2.6*23 HEAT247169 Added NDC to list of fields to prompt for, and to display on page8H
;
DISP K ABMZ S ABMZ("TITL")="MISC. SERVICES",ABMZ("PG")="8H"
I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
E D SUM^ABMDE1
;
MS ; Misc. Services
S ABMZ("CAT")=13
S ABMZ("SUB")=43
D MODE^ABMDE8X
S:((^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS")) ABMZ("DIAG")=";.06"
S ABMZ("DR")=";W !;.07//"_$$SDT^ABMDUTL(ABMP("VDT"))_";W !;.12//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.03"
S ABMZ("CHRG")=";.04"
I ABMZ("SUB")=43&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y") S ABMZ("DR")=ABMZ("DR")_";11;12;13;14" ;abm*2.6*6 5010
S ABMZ("ITEM")="Misc. Services (HCPCS Code)"
S ABMZ("DIC")="^ICPT(",ABMZ("X")="X",ABMZ("MAX")=10,ABMZ("TOTL")=0
S ABMZ("NDC")=";.19" ;abm*2.6*23 IHS/SD/AML HEAT247169
I ^ABMDEXP(ABMMODE(8),0)["UB" S ABMZ("DR")=";W !;.02"_ABMZ("DR")
D H^ABMDE8X
D HD G LOOP
HD ;
W !?5,"REVN",?60,"UNIT",?71,"TOTAL"
W !?5,"CODE",?10," HCPCS - MISC. SERVICES",?59,"CHARGE",?66,"QTY",?71,"CHARGE"
W !?5,"====",?10,"===============================================",?59,"======",?66,"===",?70,"========="
Q
LOOP S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM)) Q:'ABM S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1
S ABMZ("MOD")=.05_U_5_U_.08_U_.09
I ABMZ("NUM")>0 W !?69,"==========",!?69,$J("$"_($FN(ABMZ("TOTL"),",",2)),10)
I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
G XIT
;
PC1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM("X"),0),ABM("X")=$P(^(0),U)
S ABMZ("UNIT")=$P(ABM("X0"),U,3)
S:'+ABMZ("UNIT") ABMZ("UNIT")=1
S ABMZ(ABM("I"))=$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,2)_U_ABM_U_$P(ABM("X0"),U,2) ;CSV-c
EOP I $Y>(IOSL-5) D PAUSE^ABMDE1,HD
W !,"[",ABM("I"),"]"
I $P(ABM("X0"),"^",7) D
.W ?5,"CHARGE DATE: "
.W $$CDT^ABMDUTL($P(ABM("X0"),"^",7))
.I $P(ABM("X0"),U,12)'="",($P(ABM("X0"),U,12)'=$P(ABM("X0"),U,7)) W "-",$$CDT^ABMDUTL($P(ABM("X0"),U,12))
.S ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P","C","D",0))
.S:ABMRPRV="" ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P","C","R",0))
.I ABMRPRV'="" D ;rendering provider on line item
..W " ("_$P($G(^VA(200,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P",ABMRPRV,0),U),0)),U)_"-"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P",ABMRPRV,0)),U,2)_")"
.I $P(ABM("X0"),U,19)'="" W !,?13,"NDC: "_$P(ABM("X0"),U,19) ;abm*2.6*23 IHS/SD/AML HEAT247169
.W !
W ?5,$$GETREV^ABMDUTL($P(ABM("X0"),"^",2))
W ?10,$P(ABMZ(ABM("I")),U)
S ABMZ("MOD")=""
F ABM("M")=5,8,9 S:$P(ABM("X0"),U,ABM("M"))]"" ABMZ("MOD")=ABMZ("MOD")_"-"_$P(ABM("X0"),U,ABM("M"))
W ?10 W:ABMZ("MOD")]"" ABMZ("MOD")_" "
K ABMU S ABMU(1)="?59"_U_$J($P(ABM("X0"),U,4),6,2)
S ABMU(2)="?66"_U_$J(ABMZ("UNIT"),2)
S ABMU(3)="?70"_U_$J($FN((ABMZ("UNIT")*$P(ABM("X0"),U,4)),",",2),9)
S ABMZ("TOTL")=(ABMZ("UNIT")*$P(ABM("X0"),U,4))+ABMZ("TOTL")
I $P(^ABMDPARM(DUZ(2),1,0),U,14)'="Y" S ABMU("TXT")=$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,3) ;CSV-c
;start CSV-c
E D
.S ABMU("TXT")=""
.K ABMZCPTD
.D IHSCPTD^ABMCVAPI($P(ABM("X0"),U),"ABMZCPTD","",ABMP("VDT"))
.S ABM("CP")=0
.F S ABM("CP")=$O(ABMZCPTD(ABM("CP"))) Q:(+ABM("CP")=0) D
..Q:($G(ABMZCPTD(ABM("CP")))="")
..S ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABM("CP"))_" "
;end CSV-c
I ABMU("TXT")]"" S ABMU("RM")=59,ABMU("LM")=16 D ^ABMDWRAP I 1
E W ?17,$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,3) ;CSV-c
Q
;
XIT K ABM,ABMMODE
Q
ABMDE8H ; IHS/ASDST/DMJ - Page 8 - MISC INFO ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,23**;NOV 12, 2009;Build 427
+2 ;
+3 ;IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190
+4 ; Modified to display 2nd and 3rd modifiers and units
+5 ;IHS/SD/SDR - V2.5 P8 - IM16018/IM11164 - Prompt/display provider
+6 ;IHS/SD/SDR - v2.5 p9 - IM16660 - 4-digit revenue codes
+7 ;IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple
+8 ;IHS/SD/SDR - v2.5 p10 - IM20454 - Fixed so 2nd and 3rd modifiers would be prompted for
+9 ;IHS/SD/SDR - v2.5 p10 - IM19843 - Added new prompt SERVICE TO DATE/TIME
+10 ;IHS/SD/SDR - v2.6 CSV
+11 ;IHS/SD/SDR - abm*2.6*6 - 5010 - Added prompts for DME billing fields
+12 ;IHS/SD/AML 2.6*23 HEAT247169 Added NDC to list of fields to prompt for, and to display on page8H
+13 ;
DISP KILL ABMZ
SET ABMZ("TITL")="MISC. SERVICES"
SET ABMZ("PG")="8H"
+1 IF $DATA(ABMP("DDL"))
IF $Y>(IOSL-9)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
IF 1
+2 IF '$TEST
DO SUM^ABMDE1
+3 ;
MS ; Misc. Services
+1 SET ABMZ("CAT")=13
+2 SET ABMZ("SUB")=43
+3 DO MODE^ABMDE8X
+4 IF ((^ABMDEXP(ABMMODE(8),0)["HCFA")!(^ABMDEXP(ABMMODE(8),0)["CMS"))
SET ABMZ("DIAG")=";.06"
+5 SET ABMZ("DR")=";W !;.07//"_$$SDT^ABMDUTL(ABMP("VDT"))_";W !;.12//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.03"
+6 SET ABMZ("CHRG")=";.04"
+7 ;abm*2.6*6 5010
IF ABMZ("SUB")=43&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y")
SET ABMZ("DR")=ABMZ("DR")_";11;12;13;14"
+8 SET ABMZ("ITEM")="Misc. Services (HCPCS Code)"
+9 SET ABMZ("DIC")="^ICPT("
SET ABMZ("X")="X"
SET ABMZ("MAX")=10
SET ABMZ("TOTL")=0
+10 ;abm*2.6*23 IHS/SD/AML HEAT247169
SET ABMZ("NDC")=";.19"
+11 IF ^ABMDEXP(ABMMODE(8),0)["UB"
SET ABMZ("DR")=";W !;.02"_ABMZ("DR")
+12 DO H^ABMDE8X
+13 DO HD
GOTO LOOP
HD ;
+1 WRITE !?5,"REVN",?60,"UNIT",?71,"TOTAL"
+2 WRITE !?5,"CODE",?10," HCPCS - MISC. SERVICES",?59,"CHARGE",?66,"QTY",?71,"CHARGE"
+3 WRITE !?5,"====",?10,"===============================================",?59,"======",?66,"===",?70,"========="
+4 QUIT
LOOP SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0
FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM))
IF 'ABM
QUIT
SET ABM("X")=ABM
SET ABMZ("NUM")=ABM("I")
DO PC1
+1 SET ABMZ("MOD")=.05_U_5_U_.08_U_.09
+2 IF ABMZ("NUM")>0
WRITE !?69,"==========",!?69,$JUSTIFY("$"_($FNUMBER(ABMZ("TOTL"),",",2)),10)
+3 IF +$ORDER(ABME(0))
SET ABME("CONT")=""
DO ^ABMDERR
KILL ABME("CONT")
+4 GOTO XIT
+5 ;
PC1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM("X"),0)
SET ABM("X")=$PIECE(^(0),U)
+1 SET ABMZ("UNIT")=$PIECE(ABM("X0"),U,3)
+2 IF '+ABMZ("UNIT")
SET ABMZ("UNIT")=1
+3 ;CSV-c
SET ABMZ(ABM("I"))=$PIECE($$CPT^ABMCVAPI($PIECE(ABM("X0"),U),ABMP("VDT")),U,2)_U_ABM_U_$PIECE(ABM("X0"),U,2)
EOP IF $Y>(IOSL-5)
DO PAUSE^ABMDE1
DO HD
+1 WRITE !,"[",ABM("I"),"]"
+2 IF $PIECE(ABM("X0"),"^",7)
Begin DoDot:1
+3 WRITE ?5,"CHARGE DATE: "
+4 WRITE $$CDT^ABMDUTL($PIECE(ABM("X0"),"^",7))
+5 IF $PIECE(ABM("X0"),U,12)'=""
IF ($PIECE(ABM("X0"),U,12)'=$PIECE(ABM("X0"),U,7))
WRITE "-",$$CDT^ABMDUTL($PIECE(ABM("X0"),U,12))
+6 SET ABMRPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P","C","D",0))
+7 IF ABMRPRV=""
SET ABMRPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P","C","R",0))
+8 ;rendering provider on line item
IF ABMRPRV'=""
Begin DoDot:2
+9 WRITE " ("_$PIECE($GET(^VA(200,$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P",ABMRPRV,0),U),0)),U)_"-"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,"P",ABMRPRV,0)),U,2)_")"
End DoDot:2
+10 ;abm*2.6*23 IHS/SD/AML HEAT247169
IF $PIECE(ABM("X0"),U,19)'=""
WRITE !,?13,"NDC: "_$PIECE(ABM("X0"),U,19)
+11 WRITE !
End DoDot:1
+12 WRITE ?5,$$GETREV^ABMDUTL($PIECE(ABM("X0"),"^",2))
+13 WRITE ?10,$PIECE(ABMZ(ABM("I")),U)
+14 SET ABMZ("MOD")=""
+15 FOR ABM("M")=5,8,9
IF $PIECE(ABM("X0"),U,ABM("M"))]""
SET ABMZ("MOD")=ABMZ("MOD")_"-"_$PIECE(ABM("X0"),U,ABM("M"))
+16 WRITE ?10
IF ABMZ("MOD")]""
WRITE ABMZ("MOD")_" "
+17 KILL ABMU
SET ABMU(1)="?59"_U_$JUSTIFY($PIECE(ABM("X0"),U,4),6,2)
+18 SET ABMU(2)="?66"_U_$JUSTIFY(ABMZ("UNIT"),2)
+19 SET ABMU(3)="?70"_U_$JUSTIFY($FNUMBER((ABMZ("UNIT")*$PIECE(ABM("X0"),U,4)),",",2),9)
+20 SET ABMZ("TOTL")=(ABMZ("UNIT")*$PIECE(ABM("X0"),U,4))+ABMZ("TOTL")
+21 ;CSV-c
IF $PIECE(^ABMDPARM(DUZ(2),1,0),U,14)'="Y"
SET ABMU("TXT")=$PIECE($$CPT^ABMCVAPI($PIECE(ABM("X0"),U),ABMP("VDT")),U,3)
+22 ;start CSV-c
+23 IF '$TEST
Begin DoDot:1
+24 SET ABMU("TXT")=""
+25 KILL ABMZCPTD
+26 DO IHSCPTD^ABMCVAPI($PIECE(ABM("X0"),U),"ABMZCPTD","",ABMP("VDT"))
+27 SET ABM("CP")=0
+28 FOR
SET ABM("CP")=$ORDER(ABMZCPTD(ABM("CP")))
IF (+ABM("CP")=0)
QUIT
Begin DoDot:2
+29 IF ($GET(ABMZCPTD(ABM("CP")))="")
QUIT
+30 SET ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABM("CP"))_" "
End DoDot:2
End DoDot:1
+31 ;end CSV-c
+32 IF ABMU("TXT")]""
SET ABMU("RM")=59
SET ABMU("LM")=16
DO ^ABMDWRAP
IF 1
+33 ;CSV-c
IF '$TEST
WRITE ?17,$PIECE($$CPT^ABMCVAPI($PIECE(ABM("X0"),U),ABMP("VDT")),U,3)
+34 QUIT
+35 ;
XIT KILL ABM,ABMMODE
+1 QUIT
