ABMDE8A ; IHS/ASDST/DMJ - Page 8 - MEDICAL CARE ;
;;2.6;IHS 3P BILLING SYSTEM;**18**;NOV 12, 2009;Build 289
;
; IHS/ASDS/DMJ - v2.4 p7 - 9/7/01 NOIS HQW-0701-100066
; Modifications done related to Medicare Part B
;
; IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190
; Modified to include 2nd and 3rd modifiers on display
; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164
; Prompt/display provider
; IHS/SD/SDR - v2.5 p9 - IM16660
; 4-digit revenue codes
; IHS/SD/SDR - v2.5 p9 - task 1
; Use provider multiple at line item
; IHS/SD/SDR - v2.5 p10 - IM19843
; Added new prompt SERVICE TO DATE/TIME
; IHS/SD/SDR - v2.5 p11 - NPI
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*18 - HEAT242924 - Added code so coor. dx would be prompted for on the 5010 837D.
;
DISP ;
K ABMZ
S ABMZ("TITL")="MEDICAL SERVICES"
S ABMZ("PG")="8A"
I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
E D SUM^ABMDE1
;
PC ; Medical Care
S:'$D(ABMP("FEE")) ABMP("FEE")=1
S ABMZ("CAT")=19
S ABMZ("SUB")=27
S ABMZ("DR")=";W !;.07//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.12//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.03//1"
D
.S ABMDPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","A",0))
.S ABMDPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,+ABMDPRV,0)),U)
S ABMZ("CHRG")=";W !;.04"
S ABMZ("ITEM")="Medical Service (CPT Code)"
S ABMZ("DIC")="^ICPT("
S ABMZ("X")="X"
S ABMZ("MAX")=30
S ABMZ("TOTL")=0
D MODE^ABMDE8X
I ^ABMDEXP(ABMMODE(1),0)["UB" D
.S ABMZ("REVN")=";W !;.02//960"
;I ^ABMDEXP(ABMMODE(1),0)["HCFA"!(^ABMDEXP(ABMMODE(1),0)["CMS") S ABMZ("DIAG")=";.06" ;abm*2.6*18 IHS/SD/SDR HEAT242924
I ^ABMDEXP(ABMMODE(1),0)["HCFA"!(^ABMDEXP(ABMMODE(1),0)["CMS")!(ABMMODE(1)=33) S ABMZ("DIAG")=";.06" ;abm*2.6*18 IHS/SD/SDR HEAT242924
D A^ABMDE8X
D HD
G LOOP
;
HD ;
W !?5,"REVN",?60,"UNIT",?71,"TOTAL"
W !?5,"CODE",?10," CPT - MEDICAL 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"),27,ABM)) Q:'ABM S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
S ABMZ("MOD")=.05_U_1_U_.08_U_.09
G XIT:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
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"),27,ABM("X"),0),ABM("X")=$P(^(0),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")) I $P(ABM("X0"),U,ABM("M"))=90 S ABME(172)=""
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
S ABMZ("UNIT")=$P(ABM("X0"),U,3)
S:'+ABMZ("UNIT") ABMZ("UNIT")=1
;
EOP ;
I $Y>(IOSL-5) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) D 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,7)'=$P(ABM("X0"),U,12)) W "-",$$CDT^ABMDUTL($P(ABM("X0"),U,12))
.S ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P","C","D",0)) ;ordering
.S:ABMRPRV="" ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P","C","R",0)) ;rendering
.I ABMRPRV'="" D ;provider on line item
..W " ("_$P($G(^VA(200,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P",ABMRPRV,0),U),0)),U)_"-"_$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P",ABMRPRV,0),U,2)_")"
.W !
W ?5,$$GETREV^ABMDUTL($P(ABM("X0"),U,2))
W ?10,$P(ABMZ(ABM("I")),U) 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),0),U,3) ;CSV-c
E S ABMU("TXT")="",ABM("CP")=0 F S ABM("CP")=$O(^ICPT($P(ABM("X0"),U),"D",ABM("CP"))) Q:'ABM("CP") Q:'$D(^(ABM("CP"),0)) S ABMU("TXT")=ABMU("TXT")_^(0)_" "
S ABMU("RM")=58,ABMU("LM")=16+$L(ABMZ("MOD")) S:ABMZ("MOD") ABMU("TAB")=3+$L(ABMZ("MOD")) D ^ABMDWRAP
Q
;
XIT ;
K ABM,ABMMODE
Q
ABMDE8A ; IHS/ASDST/DMJ - Page 8 - MEDICAL CARE ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**18**;NOV 12, 2009;Build 289
+2 ;
+3 ; IHS/ASDS/DMJ - v2.4 p7 - 9/7/01 NOIS HQW-0701-100066
+4 ; Modifications done related to Medicare Part B
+5 ;
+6 ; IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190
+7 ; Modified to include 2nd and 3rd modifiers on display
+8 ; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164
+9 ; Prompt/display provider
+10 ; IHS/SD/SDR - v2.5 p9 - IM16660
+11 ; 4-digit revenue codes
+12 ; IHS/SD/SDR - v2.5 p9 - task 1
+13 ; Use provider multiple at line item
+14 ; IHS/SD/SDR - v2.5 p10 - IM19843
+15 ; Added new prompt SERVICE TO DATE/TIME
+16 ; IHS/SD/SDR - v2.5 p11 - NPI
+17 ;
+18 ; IHS/SD/SDR - v2.6 CSV
+19 ;IHS/SD/SDR - 2.6*18 - HEAT242924 - Added code so coor. dx would be prompted for on the 5010 837D.
+20 ;
DISP ;
+1 KILL ABMZ
+2 SET ABMZ("TITL")="MEDICAL SERVICES"
+3 SET ABMZ("PG")="8A"
+4 IF $DATA(ABMP("DDL"))
IF $Y>(IOSL-9)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
IF 1
+5 IF '$TEST
DO SUM^ABMDE1
+6 ;
PC ; Medical Care
+1 IF '$DATA(ABMP("FEE"))
SET ABMP("FEE")=1
+2 SET ABMZ("CAT")=19
+3 SET ABMZ("SUB")=27
+4 SET ABMZ("DR")=";W !;.07//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.12//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.03//1"
+5 Begin DoDot:1
+6 SET ABMDPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","A",0))
+7 SET ABMDPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,+ABMDPRV,0)),U)
End DoDot:1
+8 SET ABMZ("CHRG")=";W !;.04"
+9 SET ABMZ("ITEM")="Medical Service (CPT Code)"
+10 SET ABMZ("DIC")="^ICPT("
+11 SET ABMZ("X")="X"
+12 SET ABMZ("MAX")=30
+13 SET ABMZ("TOTL")=0
+14 DO MODE^ABMDE8X
+15 IF ^ABMDEXP(ABMMODE(1),0)["UB"
Begin DoDot:1
+16 SET ABMZ("REVN")=";W !;.02//960"
End DoDot:1
+17 ;I ^ABMDEXP(ABMMODE(1),0)["HCFA"!(^ABMDEXP(ABMMODE(1),0)["CMS") S ABMZ("DIAG")=";.06" ;abm*2.6*18 IHS/SD/SDR HEAT242924
+18 ;abm*2.6*18 IHS/SD/SDR HEAT242924
IF ^ABMDEXP(ABMMODE(1),0)["HCFA"!(^ABMDEXP(ABMMODE(1),0)["CMS")!(ABMMODE(1)=33)
SET ABMZ("DIAG")=";.06"
+19 DO A^ABMDE8X
+20 DO HD
+21 GOTO LOOP
+22 ;
HD ;
+1 WRITE !?5,"REVN",?60,"UNIT",?71,"TOTAL"
+2 WRITE !?5,"CODE",?10," CPT - MEDICAL SERVICES",?59,"CHARGE",?66,"QTY",?71,"CHARGE"
+3 WRITE !?5,"====",?10,"===============================================",?59,"======",?66,"===",?70,"========="
+4 QUIT
+5 ;
LOOP ;
+1 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0
+2 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM))
IF 'ABM
QUIT
SET ABM("X")=ABM
SET ABMZ("NUM")=ABM("I")
DO PC1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+3 SET ABMZ("MOD")=.05_U_1_U_.08_U_.09
+4 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+5 IF ABMZ("NUM")>0
WRITE !?69,"==========",!?69,$JUSTIFY("$"_($FNUMBER(ABMZ("TOTL"),",",2)),10)
+6 IF +$ORDER(ABME(0))
SET ABME("CONT")=""
DO ^ABMDERR
KILL ABME("CONT")
+7 GOTO XIT
+8 ;
PC1 ;
+1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM("X"),0)
SET ABM("X")=$PIECE(^(0),U)
+2 SET ABMZ("MOD")=""
+3 FOR ABM("M")=5,8,9
IF $PIECE(ABM("X0"),U,ABM("M"))]""
SET ABMZ("MOD")=ABMZ("MOD")_"-"_$PIECE(ABM("X0"),U,ABM("M"))
IF $PIECE(ABM("X0"),U,ABM("M"))=90
SET ABME(172)=""
+4 ;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)
+5 SET ABMZ("UNIT")=$PIECE(ABM("X0"),U,3)
+6 IF '+ABMZ("UNIT")
SET ABMZ("UNIT")=1
+7 ;
EOP ;
+1 IF $Y>(IOSL-5)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
DO HD
+2 WRITE !,"[",ABM("I"),"]"
+3 IF $PIECE(ABM("X0"),"^",7)
Begin DoDot:1
+4 WRITE ?5,"CHARGE DATE: "
+5 WRITE $$CDT^ABMDUTL($PIECE(ABM("X0"),"^",7))
+6 IF $PIECE(ABM("X0"),U,12)'=""
IF ($PIECE(ABM("X0"),U,7)'=$PIECE(ABM("X0"),U,12))
WRITE "-",$$CDT^ABMDUTL($PIECE(ABM("X0"),U,12))
+7 ;ordering
SET ABMRPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P","C","D",0))
+8 ;rendering
IF ABMRPRV=""
SET ABMRPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P","C","R",0))
+9 ;provider on line item
IF ABMRPRV'=""
Begin DoDot:2
+10 WRITE " ("_$PIECE($GET(^VA(200,$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P",ABMRPRV,0),U),0)),U)_"-"_$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,"P",ABMRPRV,0),U,2)_")"
End DoDot:2
+11 WRITE !
End DoDot:1
+12 WRITE ?5,$$GETREV^ABMDUTL($PIECE(ABM("X0"),U,2))
+13 WRITE ?10,$PIECE(ABMZ(ABM("I")),U)
IF ABMZ("MOD")]""
WRITE ABMZ("MOD")
+14 KILL ABMU
+15 SET ABMU(1)="?59"_U_$JUSTIFY($PIECE(ABM("X0"),U,4),6,2)
+16 SET ABMU(2)="?66"_U_$JUSTIFY(ABMZ("UNIT"),2)
+17 SET ABMU(3)="?70"_U_$JUSTIFY($FNUMBER((ABMZ("UNIT")*$PIECE(ABM("X0"),U,4)),",",2),9)
+18 SET ABMZ("TOTL")=(ABMZ("UNIT")*$PIECE(ABM("X0"),U,4))+ABMZ("TOTL")
+19 ;CSV-c
IF $PIECE(^ABMDPARM(DUZ(2),1,0),U,14)'="Y"
SET ABMU("TXT")=$PIECE($$CPT^ABMCVAPI($PIECE(ABM("X0"),U),0),U,3)
+20 IF '$TEST
SET ABMU("TXT")=""
SET ABM("CP")=0
FOR
SET ABM("CP")=$ORDER(^ICPT($PIECE(ABM("X0"),U),"D",ABM("CP")))
IF 'ABM("CP")
QUIT
IF '$DATA(^(ABM("CP"),0))
QUIT
SET ABMU("TXT")=ABMU("TXT")_^(0)_" "
+21 SET ABMU("RM")=58
SET ABMU("LM")=16+$LENGTH(ABMZ("MOD"))
IF ABMZ("MOD")
SET ABMU("TAB")=3+$LENGTH(ABMZ("MOD"))
DO ^ABMDWRAP
+22 QUIT
+23 ;
XIT ;
+1 KILL ABM,ABMMODE
+2 QUIT
