Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE8F

ABMDE8F.m

Go to the documentation of this file. 
  1. ABMDE8F ; IHS/ASDST/DMJ - Page 8 - RADIOLOGY ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/DSD/LSL - 09/01/98 - Patch 2 - NOIS NDA-0898-180038
  1.  ;             0.00 charges on HCFA because version 2.0 does not assume
  1.  ;             1 for units.  Modify code to set units to 1 if not
  1.  ;             already defined.
  1.  ; IHS/ASDS/DMJ - v2.4 p7 - 9/7/01 NOIS HQW-0701-100066
  1.  ;     Modifications done related to Medicare Part B
  1.  ; IHS/SD/SDR - V2.5 P2 - 5/9/02 - NOIS HQW-0302-100190
  1.  ;     Modified to display 2nd and 3rd modifiers and units
  1.  ; IHS/SD/SDR - V2.5 P8 - IM10618
  1.  ;    Prompt/display provider
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16660
  1.  ;   4-digit revenue codes
  1.  ; IHS/SD/SDR - v2.5 p9 - task 1
  1.  ;    Use new service line provider multiple
  1.  ; IHS/SD/SDR - v2.5 p10 - IM19843
  1.  ;   Added new prompt SERVICE TO DATE/TIME
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;
  1. DISP K ABMZ S ABMZ("TITL")="RADIOLOGY SERVICES",ABMZ("PG")="8F"
  1.  I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
  1.  E  D SUM^ABMDE1
  1.  ;
  1.  D F^ABMDE8X
  1. FEE S ABMZ("CAT")=15
  1.  S ABMZ("SUB")=35
  1.  D MODE^ABMDE8X
  1.  S:((^ABMDEXP(ABMMODE(6),0)["HCFA")!(^ABMDEXP(ABMMODE(6),0)["CMS")) ABMZ("DIAG")=";.08"
  1.  S ABMZ("DR")=";W !;.09//"_$$SDT^ABMDUTL(ABMP("VDT"))_";W !;.12//"_$$SDT^ABMDUTL(ABMP("VDT"))_";.03//1"
  1.  S ABMZ("CHRG")=";W !;.04",ABMZ("ITEM")="Radiology (CPT Code)",ABMZ("DIC")="^ICPT(",ABMZ("X")="X",ABMZ("MAX")=50,ABMZ("TOTL")=0
  1.  I ^ABMDEXP(ABMMODE(6),0)["UB" S ABMZ("REVN")=";W !;.02//320"
  1.  D HD G LOOP
  1. HD W !?5,"REVN",?60,"UNIT",?71,"TOTAL"
  1.  W !?5,"CODE",?10,"        CPT - RADIOLOGY SERVICES",?59,"CHARGE",?66,"QTY",?71,"CHARGE"
  1.  W !?5,"====",?10,"===============================================",?59,"======",?66,"===",?70,"========="
  1.  Q
  1. LOOP S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM)) Q:'ABM  S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1
  1.  S ABMZ("MOD")=.05_U_4_U_.06_U_.07
  1.  I ABMZ("NUM")>0 W !?69,"==========",!?69,$J("$"_($FN(ABMZ("TOTL"),",",2)),10)
  1.  I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
  1.  G XIT
  1.  ;
  1. PC1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM("X"),0),ABM("X")=$P(^(0),U)
  1.  S ABMZ("UNIT")=$P(ABM("X0"),U,3)
  1.  S:'+ABMZ("UNIT") ABMZ("UNIT")=1
  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
  1. EOP I $Y>(IOSL-5) D PAUSE^ABMDE1,HD
  1.  W !,"[",ABM("I"),"]"
  1.  I $P(ABM("X0"),"^",9) D
  1.  .W ?5,"CHARGE DATE: "
  1.  .W $$CDT^ABMDUTL($P(ABM("X0"),"^",9))
  1.  .I $P(ABM("X0"),U,12)'="",($P(ABM("X0"),U,12)'=$P(ABM("X0"),U,9)) W "-",$$CDT^ABMDUTL($P(ABM("X0"),U,12))
  1.  .S ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,"P","C","D",0))
  1.  .S:ABMRPRV="" ABMRPRV=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,"P","C","R",0))
  1.  .I ABMRPRV'="" D  ;rendering provider on line item
  1.  ..W " ("_$P($G(^VA(200,$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,"P",ABMRPRV,0),U),0)),U)_"-"_$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,"P",ABMRPRV,0),U,2)_")"
  1.  .W !
  1.  W ?5,$$GETREV^ABMDUTL($P(ABM("X0"),U,2))
  1.  S ABMZ("MOD")=""
  1.  F ABM("M")=5,6,7 S:$P(ABM("X0"),U,ABM("M"))]"" ABMZ("MOD")=ABMZ("MOD")_"-"_$P(ABM("X0"),U,ABM("M"))
  1.  W ?10,$P(ABMZ(ABM("I")),U) W:ABMZ("MOD")]"" ABMZ("MOD")
  1.  K ABMU S ABMU(1)="?59"_U_$J($P(ABM("X0"),U,4),6,2)
  1.  S ABMU(2)="?66"_U_$J(ABMZ("UNIT"),2)
  1.  S ABMU(3)="?70"_U_$J($FN((ABMZ("UNIT")*$P(ABM("X0"),U,4)),",",2),9)
  1.  S ABMZ("TOTL")=(ABMZ("UNIT")*$P(ABM("X0"),U,4))+ABMZ("TOTL")
  1.  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
  1.  ;start CSV-c
  1.  E  D
  1.  .S ABMU("TXT")=""
  1.  .K ABMZCPTD
  1.  .D IHSCPTD^ABMCVAPI($P(ABM("X0"),U),"ABMZCPTD","",ABMP("VDT"))
  1.  .S ABM("CP")=0
  1.  .F  S ABM("CP")=$O(ABMZCPTD(ABM("CP"))) Q:(+ABM("CP")=0)  D
  1.  ..Q:($G(ABMZCPTD(ABM("CP")))="")
  1.  ..S ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABM("CP"))_" "
  1.  ;end CSV-c
  1.  I ABMU("TXT")]"" S ABMU("RM")=58,ABMU("LM")=16+$L(ABMZ("MOD")) S:ABMZ("MOD")]"" ABMU("TAB")=3+$L(ABMZ("MOD")) D ^ABMDWRAP I 1
  1.  E  W ?17,$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,3)  ;CSV-c
  1.  Q
  1.  ;
  1. XIT K ABM,ABMMODE
  1.  Q