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

ABMDE8B.m

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