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

ABMDE8C.m

Go to the documentation of this file. 
  1. ABMDE8C ; IHS/ASDST/DMJ - Page 8 - ROOM AND BOARD ; 
  1.  ;;2.6;IHS Third Party Billing System;**2,6,8,9**;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16660 - 4-digit revenue codes
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20018 - Added CPT prompt
  1.  ; IHS/SD/SDR - v2.5 p12 - IM24096 - Changed code to correct inpatient rev codes
  1.  ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI
  1.  ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - DOS defaults but no prompt to edit it
  1.  ;
  1. DISP ;EP
  1.  K ABMZ,DIC S ABMZ("TITL")="REVENUE CODE",ABMZ("PG")="8C"
  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. FEE S ABMZ("CAT")=31,ABMZ("SUB")=25,ABMZ("DAYS")=0
  1.  S ABMZ("DR")=";W !;.02//1",ABMZ("CHRG")=";W !;.03",ABMZ("ITEM")="REVENUE CODE",ABMZ("DIC")="^AUTTREVN("
  1.  S ABMZ("X")="X",(ABMZ("TOTL"),ABMZ("DAYS"))=0
  1.  D C^ABMDE8X
  1.  D HD G LOOP
  1. HD W !?71,"TOTAL"
  1.  W !?5,"REVENUE CODE",?37,"CPT",?44,"CHARGE",?54,"DAYS",?61,"UNITS",?71,"CHARGE"
  1.  W !?5,"=============================",?37,"===",?44,"======",?54,"====",?61,"=====",?70,"========="
  1.  Q
  1. LOOP ;LOOP
  1.  S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,ABM)) Q:'ABM  S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1
  1.  I ABMZ("NUM")>0 W !?54,"====",?70,"=========",!?53,$J(ABMZ("DAYS"),4),?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"),25,ABM("X"),0),ABM("X")=$P(^(0),U)
  1.  S ABMZ("UNIT")=$P(ABM("X0"),U,2)
  1.  S:'+ABMZ("UNIT") ABMZ("UNIT")=1
  1.  S ABMZ(ABM("I"))=$$GETREV^ABMDUTL(ABM("X"))_U_ABM_U_$P(ABM("X0"),U,2)_U_$S($P(ABM("X0"),U,7):$P($G(^ICPT($P(ABM("X0"),U,7),0)),U),1:"")
  1. EOP I $Y>(IOSL-5) D PAUSE^ABMDE1,HD
  1.  I ABM("X")\10=17,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),U)'=85 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".51////85" D ^DIE
  1.  W !,"[",ABM("I"),"]"
  1.  I $P(ABM("X0"),"^",4) D
  1.  .W ?5,"CHARGE DATE: "
  1.  .W $$CDT^ABMDUTL($P(ABM("X0"),"^",4)),!
  1.  W ?5,$P(ABMZ(ABM("I")),U)
  1.  S ABMU(1)="?36"_U_$P(ABMZ(ABM("I")),U,4)
  1.  S ABMU(2)="?44"_U_$J($P(ABM("X0"),U,3)+$P(ABM("X0"),U,6),6,2)
  1.  I (+ABM("X")>99&(+ABM("X")<220)) S ABMU(3)="?54"_U_$J(ABMZ("UNIT"),3),ABMZ("DAYS")=ABMZ("UNIT")+ABMZ("DAYS")
  1.  E  S ABMU(3)="?56"_U_0
  1.  S ABMU(4)="?62"_U_$J(ABMZ("UNIT"),3)
  1.  S ABMU(5)="?70"_U_$J($FN((ABMZ("UNIT")*$P(ABM("X0"),U,3))+$P(ABM("X0"),U,6),",",2),9)
  1.  S ABMZ("TOTL")=($P(ABM("X0"),U,3)*ABMZ("UNIT"))+$P(ABM("X0"),U,6)+ABMZ("TOTL")
  1.  S ABMU("TXT")=$P(^AUTTREVN(ABM("X"),0),U,2)
  1.  S ABMU("RM")=37,ABMU("LM")=10 D ^ABMDWRAP
  1.  Q
  1.  ;
  1. XIT K ABM
  1.  Q
  1. A ;ADD ENTRY
  1.  S DIC("P")=$P(^DD(9002274.3,25,0),U,2)
  1.  S DIC="^AUTTREVN(",DIC(0)="AEMQ"
  1.  K DIC("A")
  1.  D ^DIC
  1.  Q:+Y<0  S ABMZ("RVCODE")=+Y
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIC="^ABMDCLM(DUZ(2),DA(1),25,",X=ABMZ("RVCODE")
  1.  K DD,DO D FILE^DICN
  1.  Q:+Y<0  S DA=+Y
  1.  S ABMZ("NUM")=+$G(ABMZ("NUM"))+1
  1.  D DEL100
  1. E ;EDIT EXISTING ENTRY
  1.  I '$G(ABMZ("NUM")) G A
  1.  I '$G(ABMZ("RVCODE")) D
  1.  .K DA
  1.  .S DA(1)=ABMP("CDFN")
  1.  .I ABMZ("NUM")=1 S Y=1
  1.  .E  S DIR(0)="NO^1:"_ABMZ("NUM") D ^DIR K DIR Q:'Y
  1.  .S DA=$P(ABMZ(Y),"^",2)
  1.  .S ABMZ("RVCODE")=$P(^ABMDCLM(DUZ(2),DA(1),25,DA,0),U)
  1.  Q:'$G(DA)
  1.  ;S ABMZ("UC")=$P($G(^ABMDFEE(ABMP("FEE"),31,ABMZ("RVCODE"),0)),"^",2)  ;abm*2.6*2 3PMS10003A
  1.  S ABMZ("UC")=$P($$ONE^ABMFEAPI(ABMP("FEE"),31,ABMZ("RVCODE"),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A
  1.  S DIE="^ABMDCLM(DUZ(2),DA(1),25,"
  1.  S DR=".02;.03//"_ABMZ("UC")_";.07"
  1.  ;start new code abm*2.6*9 NARR
  1.  D ^DIE
  1.  S DR=""
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7))) D
  1.  .Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"  ;only 5010 formats
  1.  .S ABMCNCK=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0))
  1.  .I ABMCNCK,$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y" S DR="22"
  1.  ;end new code abm*2.6*9 NARR
  1.  ;S:'$P(^AUTTREVN(ABMZ("RVCODE"),0),"^",5) DR=DR_";.04"  ;abm*2.6*6 NOHEAT
  1.  S DR=DR_";.04"  ;abm*2.6*6 NOHEAT
  1.  D ^DIE
  1.  ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)'="",($P($G(^DIC(81.1,$P($G(^ICPT($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0)),U,3),0)),U)["IMMUNIZATION") S DR="15//" D ^DIE  ;abm*2.6*6 5010  ;abm*2.6*8 HEAT41190
  1.  S ABMTCPT=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7)  ;abm*2.6*8 HEAT41190
  1.  I ABMTCPT'="",$P($G(^ICPT($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,DA,0)),U,7),0)),U,3),($P($G(^DIC(81.1,$P($G(^ICPT(ABMTCPT,0)),U,3),0)),U)["IMMUNIZATION") S DR="15//" D ^DIE  ;abm*2.6*8 HEAT41190
  1.  Q
  1. DEL100 ;if 100 ask to delete
  1.  Q:ABMZ("RVCODE")'=100
  1.  W !!,"You have entered an all inclusive revenue code. Do you want to"
  1.  W !,$$EN^ABMVDF("RVN"),"DELETE ALL",$$EN^ABMVDF("RVF")," line items from the other pages?",!
  1.  S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
  1.  Q:Y'=1
  1.  W !
  1.  N I F I=21,23,27,33,35,37,39,43,45 D
  1.  .Q:'$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,0))
  1.  .W !,$P(^DD(9002274.3,I,0),U)," deleted."
  1.  .K ^ABMDCLM(DUZ(2),ABMP("CDFN"),I)
  1.  W !
  1.  Q