ABMDE8B ; IHS/ASDST/DMJ - Edit Page 8 - WORKSHEET SURG PROC ;
;;2.6;IHS 3P BILLING SYSTEM;**6,14,21**;NOV 12, 2009;Build 379
;A few lines have been added in the ICD subrtn so that surgery page
;can accommodate surgical CPT's entered by claim generator
;
; IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190 - Modified to include 2nd and 3rd modifiers and well as units
; 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 new service line provider multiple
; IHS/SD/SDR - v2.5 p10 - IM19843 - Added code for new SERVICE DATE TO prompt
; IHS/SD/SDR - v2.5 p11 - NPI
; IHS/SD/SDR - v2.5 p13 - IM25777 - Medical charges duplicating because all line items not displaying (BAD X-REF)
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - v2.6 p6 - HEAT28973 - If 55 modifier present use '1' as units for charges
;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ for provider narrative so output transform will be executed.
;IHS/SD/SDR 2.6*21 HEAT106899 - Updated display so it will look for the new operating provider; it will look for ordering, then operating,
; then rendering and display the first one it finds.
; *********************************************************************
;
DISP2 K ABMZ S ABMZ("TITL")="SURGICAL PROCEDURES",ABMZ("PG")="8B"
I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
E D SUM^ABMDE1
APRV G MS:'$D(ABMP(638))
N I F I="A","O" D
.S ABMZ("D")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",I,0))
.I $G(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,+ABMZ("D"),0)),$P($G(^VA(200,$P(^(0),U),9999999)),U)=2 S ABMZ("CONTRACT")=""
;
MS ; Surgical Procedures
D B^ABMDE8X S ABMZ("SUB")=21,ABMZ("CAT")=11
S ABMZ("DR")=";W !;.05//"_ABMP("VISTDT")
S ABMZ("DR")=ABMZ("DR")_";W !;.19//"_ABMP("VISTDT")
S ABMDPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O",0))
S ABMDPRV=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,+ABMDPRV,0)),U)
S ABMZ("DR")=ABMZ("DR")_";.13//1"
S ABMZ("CHRG")=";W !;.07"
S ABMZ("ITEM")="Surgical (CPT Code)"
S ABMZ("DIC")="^ICPT("
S ABMZ("X")="X",ABM("TOTL")=0
S ABMZ("NARR")=";.06////"_U_2_U_7
D MODE^ABMDE8X
I ^ABMDEXP(ABMMODE(2),0)["UB" S ABMZ("DR")=";W !;.03//960"_ABMZ("DR")
S:((^ABMDEXP(ABMMODE(2),0)["HCFA")!(^ABMDEXP(ABMMODE(2),0)["CMS")) ABMZ("DIAG")=";.04"
D HD G LOOP
G:'$D(ABMP("VTYP",999)) ^ABMDE8B1
HD ;
W !,"BIL",?5,"SERV",?12,"REVN",?19,"CORR",?26,"CPT"
W !,"SEQ",?5,"DATE",?12,"CODE",?19,"DIAG",?26,"CODE",?41,"PROVIDER'S NARRATIVE",?64,"UNITS",?72,"CHARGE"
W !,"===",?5,"=====",?12,"====",?18,"======",?26,"===========================================",?71,"========"
Q
LOOP S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM)) Q:'ABM S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D MS1
S ABM("L")=ABMZ("LNUM")+1,ABMZ("DR2")=";.02////"_ABM("L")
S ABMZ("MOD")=.09_U_3_U_.11_U_.12
TOTL I ABM("TOTL")>0 W !?70,"=========",!?68,$J(("$"_$FN(ABM("TOTL"),",",2)),11)
G XIT
;
MS1 ;
; If no data in surgical multiple, kill the x-ref that brought us here
I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),0)) K ^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM,ABM("X")) Q
S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),0)
S ABM("X1")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),1))
S:ABMZ("LNUM")<$P(ABM("X0"),U,2) ABMZ("LNUM")=$P(ABM("X0"),U,2)
;
ICD ;
K ABM("ICD0")
S ABM("ICD")=0
S ABMZ(ABM("I"))=$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,2)_U_ABM("X")_U_$P(ABM("X0"),U)_U_$P(ABM("X0"),U,3,13) ;CSV-c
EOP I $Y>(IOSL-5) D PAUSE^ABMDE1,HD
S ABMZ("MOD")=""
F ABM("M")=9,11,12 D
.S:$P($S(ABM("M")=9:ABM("X0"),1:ABM("X1")),U,ABM("M"))]"" ABMZ("MOD")=ABMZ("MOD")_"-"_$P($S(ABM("M")=9:ABM("X0"),1:ABM("X1")),U,ABM("M"))
S ABM("LITMTOTAL")=$P(ABM("X0"),"^",7)*$P(ABM("X0"),"^",13)
I ABMZ("MOD")["55" S ABM("LITMTOTAL")=$P(ABM("X0"),"^",7)*(1) ;IHS/SD/AML 2/10/2011 - HEAT28973
S:'+ABM("LITMTOTAL") ABM("LITMTOTAL")=$P(ABM("X0"),"^",7)
K ABMU S ABMU(1)="?70"_U_$J($FN(ABM("LITMTOTAL"),",",2),9)
S ABM("TOTL")=ABM("TOTL")+ABM("LITMTOTAL")
W !,$J(ABM("I"),2)
W ?5,"CHARGE DATE: ",$$SDT^ABMDUTL($P(ABM("X0"),U,5))
I $P(ABM("X0"),U,19)'="",($P(ABM("X0"),U,19)'=$P(ABM("X0"),U,5)) W "-",$$SDT^ABMDUTL($P(ABM("X0"),U,19))
I $P(ABM("X0"),U,14) D
.W " ("_$P($G(^VA(200,$P(ABM("X0"),U,14),0)),U)_")"
S ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P","C","D",0))
S:ABMRPRV="" ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P","C","O",0)) ;abm*2.6*21 IHS/SD/SDR HEAT106899
S:ABMRPRV="" ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P","C","R",0))
I ABMRPRV'="" D ;rendering provider on line item
.W " ("_$P($G(^VA(200,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P",ABMRPRV,0),U),0)),U)_"-"_$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P",ABMRPRV,0),U,2)_")"
W !,?12,$$GETREV^ABMDUTL($P(ABM("X0"),U,3))
W ?18,$P(ABM("X0"),U,4)
W ?26,$P(ABMZ(ABM("I")),U) W:ABMZ("MOD")]"" ABMZ("MOD")
;S ABMU("TXT")=$S($P(ABM("X0"),U,6)]"":$P($G(^AUTNPOV($P(ABM("X0"),U,6),0)),U),1:"") ;abm*2.6*14 HEAT161263
S IENS=ABM("X")_","_ABMP("CDFN")_"," ;abm*2.6*14 HEAT161263
S ABMU("TXT")=$S($P(ABM("X0"),U,6)]"":$$GET1^DIQ(9002274.3021,IENS,".06","E"),1:"") ;abm*2.6*14 HEAT161263
S ABMU("LM")=32+$L(ABMZ("MOD"))
S ABMU("RM")=70
S ABMU("TAB")=$L(ABMZ("MOD"))
S ABMU("2TXT")=$P($G(ABM("X0")),U,13)
S ABMU("2LM")=68
S ABMU("2RM")=72
D ^ABMDWRAP
W:$X<33 ?68,$J(("$"_$FN(ABM("LITMTOTAL"),",",2)),11)
Q
;
XIT I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
K ABM,ABMMODE
Q
ABMDE8B ; IHS/ASDST/DMJ - Edit Page 8 - WORKSHEET SURG PROC ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,14,21**;NOV 12, 2009;Build 379
+2 ;A few lines have been added in the ICD subrtn so that surgery page
+3 ;can accommodate surgical CPT's entered by claim generator
+4 ;
+5 ; IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190 - Modified to include 2nd and 3rd modifiers and well as units
+6 ; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164 - Prompt/display provider
+7 ; IHS/SD/SDR - v2.5 p9 - IM16660 - 4-digit revenue codes
+8 ; IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple
+9 ; IHS/SD/SDR - v2.5 p10 - IM19843 - Added code for new SERVICE DATE TO prompt
+10 ; IHS/SD/SDR - v2.5 p11 - NPI
+11 ; IHS/SD/SDR - v2.5 p13 - IM25777 - Medical charges duplicating because all line items not displaying (BAD X-REF)
+12 ;
+13 ; IHS/SD/SDR - v2.6 CSV
+14 ; IHS/SD/SDR - v2.6 p6 - HEAT28973 - If 55 modifier present use '1' as units for charges
+15 ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ for provider narrative so output transform will be executed.
+16 ;IHS/SD/SDR 2.6*21 HEAT106899 - Updated display so it will look for the new operating provider; it will look for ordering, then operating,
+17 ; then rendering and display the first one it finds.
+18 ; *********************************************************************
+19 ;
DISP2 KILL ABMZ
SET ABMZ("TITL")="SURGICAL PROCEDURES"
SET ABMZ("PG")="8B"
+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
APRV IF '$DATA(ABMP(638))
GOTO MS
+1 NEW I
FOR I="A","O"
Begin DoDot:1
+2 SET ABMZ("D")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",I,0))
+3 IF $GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,+ABMZ("D"),0))
IF $PIECE($GET(^VA(200,$PIECE(^(0),U),9999999)),U)=2
SET ABMZ("CONTRACT")=""
End DoDot:1
+4 ;
MS ; Surgical Procedures
+1 DO B^ABMDE8X
SET ABMZ("SUB")=21
SET ABMZ("CAT")=11
+2 SET ABMZ("DR")=";W !;.05//"_ABMP("VISTDT")
+3 SET ABMZ("DR")=ABMZ("DR")_";W !;.19//"_ABMP("VISTDT")
+4 SET ABMDPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C","O",0))
+5 SET ABMDPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,+ABMDPRV,0)),U)
+6 SET ABMZ("DR")=ABMZ("DR")_";.13//1"
+7 SET ABMZ("CHRG")=";W !;.07"
+8 SET ABMZ("ITEM")="Surgical (CPT Code)"
+9 SET ABMZ("DIC")="^ICPT("
+10 SET ABMZ("X")="X"
SET ABM("TOTL")=0
+11 SET ABMZ("NARR")=";.06////"_U_2_U_7
+12 DO MODE^ABMDE8X
+13 IF ^ABMDEXP(ABMMODE(2),0)["UB"
SET ABMZ("DR")=";W !;.03//960"_ABMZ("DR")
+14 IF ((^ABMDEXP(ABMMODE(2),0)["HCFA")!(^ABMDEXP(ABMMODE(2),0)["CMS"))
SET ABMZ("DIAG")=";.04"
+15 DO HD
GOTO LOOP
+16 IF '$DATA(ABMP("VTYP",999))
GOTO ^ABMDE8B1
HD ;
+1 WRITE !,"BIL",?5,"SERV",?12,"REVN",?19,"CORR",?26,"CPT"
+2 WRITE !,"SEQ",?5,"DATE",?12,"CODE",?19,"DIAG",?26,"CODE",?41,"PROVIDER'S NARRATIVE",?64,"UNITS",?72,"CHARGE"
+3 WRITE !,"===",?5,"=====",?12,"====",?18,"======",?26,"===========================================",?71,"========"
+4 QUIT
LOOP SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0
+1 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM))
IF 'ABM
QUIT
SET ABM("X")=ABM
SET ABMZ("NUM")=ABM("I")
DO MS1
+2 SET ABM("L")=ABMZ("LNUM")+1
SET ABMZ("DR2")=";.02////"_ABM("L")
+3 SET ABMZ("MOD")=.09_U_3_U_.11_U_.12
TOTL IF ABM("TOTL")>0
WRITE !?70,"=========",!?68,$JUSTIFY(("$"_$FNUMBER(ABM("TOTL"),",",2)),11)
+1 GOTO XIT
+2 ;
MS1 ;
+1 ; If no data in surgical multiple, kill the x-ref that brought us here
+2 IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),0))
KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM,ABM("X"))
QUIT
+3 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),0)
+4 SET ABM("X1")=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),1))
+5 IF ABMZ("LNUM")<$PIECE(ABM("X0"),U,2)
SET ABMZ("LNUM")=$PIECE(ABM("X0"),U,2)
+6 ;
ICD ;
+1 KILL ABM("ICD0")
+2 SET ABM("ICD")=0
+3 ;CSV-c
SET ABMZ(ABM("I"))=$PIECE($$CPT^ABMCVAPI($PIECE(ABM("X0"),U),ABMP("VDT")),U,2)_U_ABM("X")_U_$PIECE(ABM("X0"),U)_U_$PIECE(ABM("X0"),U,3,13)
EOP IF $Y>(IOSL-5)
DO PAUSE^ABMDE1
DO HD
+1 SET ABMZ("MOD")=""
+2 FOR ABM("M")=9,11,12
Begin DoDot:1
+3 IF $PIECE($SELECT(ABM("M")=9
SET ABMZ("MOD")=ABMZ("MOD")_"-"_$PIECE($SELECT(ABM("M")=9:ABM("X0"),1:ABM("X1")),U,ABM("M"))
End DoDot:1
+4 SET ABM("LITMTOTAL")=$PIECE(ABM("X0"),"^",7)*$PIECE(ABM("X0"),"^",13)
+5 ;IHS/SD/AML 2/10/2011 - HEAT28973
IF ABMZ("MOD")["55"
SET ABM("LITMTOTAL")=$PIECE(ABM("X0"),"^",7)*(1)
+6 IF '+ABM("LITMTOTAL")
SET ABM("LITMTOTAL")=$PIECE(ABM("X0"),"^",7)
+7 KILL ABMU
SET ABMU(1)="?70"_U_$JUSTIFY($FNUMBER(ABM("LITMTOTAL"),",",2),9)
+8 SET ABM("TOTL")=ABM("TOTL")+ABM("LITMTOTAL")
+9 WRITE !,$JUSTIFY(ABM("I"),2)
+10 WRITE ?5,"CHARGE DATE: ",$$SDT^ABMDUTL($PIECE(ABM("X0"),U,5))
+11 IF $PIECE(ABM("X0"),U,19)'=""
IF ($PIECE(ABM("X0"),U,19)'=$PIECE(ABM("X0"),U,5))
WRITE "-",$$SDT^ABMDUTL($PIECE(ABM("X0"),U,19))
+12 IF $PIECE(ABM("X0"),U,14)
Begin DoDot:1
+13 WRITE " ("_$PIECE($GET(^VA(200,$PIECE(ABM("X0"),U,14),0)),U)_")"
End DoDot:1
+14 SET ABMRPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P","C","D",0))
+15 ;abm*2.6*21 IHS/SD/SDR HEAT106899
IF ABMRPRV=""
SET ABMRPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P","C","O",0))
+16 IF ABMRPRV=""
SET ABMRPRV=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P","C","R",0))
+17 ;rendering provider on line item
IF ABMRPRV'=""
Begin DoDot:1
+18 WRITE " ("_$PIECE($GET(^VA(200,$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P",ABMRPRV,0),U),0)),U)_"-"_$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM,"P",ABMRPRV,0),U,2)_")"
End DoDot:1
+19 WRITE !,?12,$$GETREV^ABMDUTL($PIECE(ABM("X0"),U,3))
+20 WRITE ?18,$PIECE(ABM("X0"),U,4)
+21 WRITE ?26,$PIECE(ABMZ(ABM("I")),U)
IF ABMZ("MOD")]""
WRITE ABMZ("MOD")
+22 ;S ABMU("TXT")=$S($P(ABM("X0"),U,6)]"":$P($G(^AUTNPOV($P(ABM("X0"),U,6),0)),U),1:"") ;abm*2.6*14 HEAT161263
+23 ;abm*2.6*14 HEAT161263
SET IENS=ABM("X")_","_ABMP("CDFN")_","
+24 ;abm*2.6*14 HEAT161263
SET ABMU("TXT")=$SELECT($PIECE(ABM("X0"),U,6)]"":$$GET1^DIQ(9002274.3021,IENS,".06","E"),1:"")
+25 SET ABMU("LM")=32+$LENGTH(ABMZ("MOD"))
+26 SET ABMU("RM")=70
+27 SET ABMU("TAB")=$LENGTH(ABMZ("MOD"))
+28 SET ABMU("2TXT")=$PIECE($GET(ABM("X0")),U,13)
+29 SET ABMU("2LM")=68
+30 SET ABMU("2RM")=72
+31 DO ^ABMDWRAP
+32 IF $X<33
WRITE ?68,$JUSTIFY(("$"_$FNUMBER(ABM("LITMTOTAL"),",",2)),11)
+33 QUIT
+34 ;
XIT IF +$ORDER(ABME(0))
SET ABME("CONT")=""
DO ^ABMDERR
KILL ABME("CONT")
+1 KILL ABM,ABMMODE
+2 QUIT
