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

ABMDE3B.m

Go to the documentation of this file. 
  1. ABMDE3B ; IHS/ASDST/DMJ - Edit Page 3 - QUESTIONS - part 3 ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20076
  1.  ;    Added EPSDT referral
  1.  ;
  1. 5 W ! S DIR(0)="Y",DIR("A")="["_ABM("#")_"] Was Visit an Emergency",DIR("?")="If Emergency Room Utilized as a result of Condition of Medical Severity"
  1.  I $P(ABMP("C0"),U,6)]"",$D(^DIC(40.7,$P(ABMP("C0"),U,6),0)),$P(^(0),U)["EMERGENCY" S DIR("B")="Y"
  1.  E  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),$P(^(8),U,5)="Y" S DIR("B")="Y"
  1.  I '$D(DIR("B")) S DIR("B")="N"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  I Y=1 G ASET
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),$P(^(8),U,5)="Y" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".85///@;.855///@" D ^DIE K DR
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),$P(^(5),U,1)=$O(^ABMDCODE("AC","T",1,"")) S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".51///@" D ^DIE K DR
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),5)),$P(^(5),U,2)=$O(^ABMDCODE("AC","A",7,"")) S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".52///@" D ^DIE K DR
  1.  Q
  1. ASET ;EP - Entry Point for setting Emergency Room charge
  1.  S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".85///Y"
  1.  D ^DIE K DR
  1.  ;
  1. ASRC I $P(ABMP("C0"),U,7)'=111 Q
  1.  I $P($G(^ABMDCODE(ABMP("CDFN"),5)),U,2)'="" G ATYP
  1.  S X=$O(^ABMDCODE("AC","A",7,"")) G ATYP:X=""
  1.  S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".52////"_X D ^DIE K DR
  1.  ;
  1. ATYP S X=$O(^ABMDCODE("AC","T",1,"")) Q:X=""
  1.  I $P($G(^ABMDCODE(ABMP("CDFN"),5)),U,1)'="" Q
  1.  S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".51////"_X D ^DIE K DR
  1.  Q
  1.  ;
  1. 6 ; Special Program
  1.  W ! S DIR(0)="Y",DIR("A")="["_ABM("#")_"] Was visit related to a SPECIAL PROGRAM",DIR("?")="If services provided to patient were related to a Special Program"
  1.  I $O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))]"" S DIR("B")="Y"
  1.  E  S DIR("B")="N"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  I Y=1 G SPPROG
  1.  I $O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))]"" S DA(1)=ABMP("CDFN"),ABM("X")=$O(^ABMDCLM(DUZ(2),DA(1),59,0)) I ABM("X")]"" S DA=ABM("X"),DIK="^ABMDCLM(DUZ(2),"_DA(1)_",59," D ^DIK
  1.  Q
  1.  ;
  1. SPPROG K DIC
  1.  K X,Y
  1.  S ABM("DICS")="9002274.3059" X:$D(^DD(ABM("DICS"),.01,12.1)) ^DD(ABM("DICS"),.01,12.1)
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),59))=10 S ABM("X")=$O(^(59,0)) I ABM("X")]"",$D(^(ABM("X"),0)) S ABM("X")=^(0) I $D(^ABMDCODE(ABM("X"),0)) S DIC("B")=$P(^(0),U,1)
  1.  W ! S DIC="^ABMDCODE(",DIC(0)="QEAM" S DIC("A")="Select SPECIAL PROGRAM: " D ^DIC K DIC
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(X="")
  1.  I +Y<1 G 6
  1. SP ;EP - Entry Point for setting UB-82 Special Prog code
  1.  S ABM("Y")=+Y
  1.  S DA(1)=ABMP("CDFN")
  1.  I +$O(^ABMDCLM(DUZ(2),DA(1),59,0))=0 S DIC("P")=$P(^DD(9002274.3,59,0),U,2)
  1.  I +$O(^ABMDCLM(DUZ(2),DA(1),59,0))'=0 D
  1.  .S ABM("X")=$O(^ABMDCLM(DUZ(2),DA(1),59,0))
  1.  .I ABM("X")]"" D
  1.  ..K DIR,X,Y
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("A")="Info in EPSDT fields.  Ok to delete?"
  1.  ..S DIR("B")="Y"
  1.  ..D ^DIR K DIR
  1.  ..S ABMANS=+Y
  1.  ..Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
  1.  ..I ABMANS>0 S DA=ABM("X"),DIK="^ABMDCLM(DUZ(2),"_DA(1)_",59," D ^DIK
  1.  I +$O(^ABMDCLM(DUZ(2),DA(1),59,0))'=0,(+$G(ABMANS)<1) Q
  1.  S (DINUM,X)=ABM("Y")
  1.  K DD,DO S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",59,",DIC(0)="LE"
  1.  D FILE^DICN K DIC
  1.  ;EPSDT referral?
  1.  S (DA,ABMPSCD)=+Y
  1.  S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",59,"
  1.  S DR=".02"
  1.  D ^DIE
  1.  ;If referral, up to 3 reasons
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABMPSCD,0)),U,2)="Y" D  ;referral reason
  1.  .F ABMX=1:1:3 D  Q:(+Y<0)!($D(DTOUT))!($D(DUOUT))
  1.  ..K DIC,DIE,DA,DR,X,Y
  1.  ..S DA(2)=ABMP("CDFN")
  1.  ..S DA(1)=ABMPSCD
  1.  ..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",59,"_DA(1)_",1,"
  1.  ..S DIC(0)="AEMLQ"
  1.  ..S DIC("P")=$P(^DD(9002274.3059,".03",0),U,2)
  1.  ..S DIC("A")="Select referral reason(s):"
  1.  ..D ^DIC
  1.  ..I $P(Y,U,3)'=1 S ABMX=ABMX-1
  1.  Q
  1.  ;
  1. 7 ; Outside Lab Charges
  1.  W ! S DIR(0)="NO^0:999.99:2",DIR("A")="["_ABM("#")_"] Outside Lab Charges",DIR("?")="Enter the Amount of Lab Charges that occurred Outside IHS"
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),$P(^(8),U,1)]"" S DIR("B")=$P(^(8),U)
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  I X'="" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".81////"_Y D ^DIE K DR
  1.  Q
  1.  ;
  1. 8 W ! S DIR(0)="YO",DIR("A")="["_ABM("#")_"] Was BLOOD Furnished (Y/N)",DIR("?")="If whole blood or units of packed red cells furnished to patient"
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),$P(^(7),U,6)>0 S DIR("B")="Y"
  1.  E  S DIR("B")="N"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  I Y=0 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".76///@;.77///@;.78///@;.79///@" D ^DIE K DR Q
  1.  S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".76T;.77T;.78T;.79T" D ^DIE K DR
  1.  Q
  1.  ;
  1. XIT Q