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

ABMDE3A.m

Go to the documentation of this file. 
  1. ABMDE3A ; IHS/ASDST/DMJ - Edit Page 3 - QUESTIONS - part 2 ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,13,14,15**;NOV 12, 2009;Build 251
  1.  ;
  1.  ; IHS/SD/SDR - V2.5 P8 - IM14693/IM16105 - Added code for Accident State
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16001 - Made accident related editable
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20022 - Use ROI/AOB multiples
  1.  ; IHS/SD/SDR - v2.5 p11 - NPI
  1.  ; IHS/SD/SDR - abm*2.6*6 - 5010 -changed AoB to accept "W"
  1.  ;IHS/SD/SDR - 2.6*13 - exp mode 35; made changes to link Injury Date, Date First Symptom, and 9A Occurrence codes
  1.  ;IHS/SD/SDR - 2.6*14 - HEAT165301 - Removed link that was added in patch 13 to page 9A.
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT165301 - Completely removed link to page 9A.  Now it won't even create the 9A entry.
  1.  ;
  1. 1 ;
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="["_ABM("#")_"] Was RELEASE OF INFORMATION obtained"
  1.  S DIR("?")="Is a Signed Statement for Release of Information on File"
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)]"" S DIR("B")=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,4)="Y":"Y",1:"N")
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  S ABM("Y")=Y
  1.  I Y=0 D N1 Q  ;no ROI obtained
  1.  D Y1
  1.  Q
  1. Y1 ; EP
  1.  S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".74////Y;.711R~Release Obtained Date.." D ^DIE K DR
  1.  Q
  1. N1 ;
  1.  S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".74////N;.711////@" D ^DIE K DR
  1.  Q
  1.  ;
  1. 2 ;
  1.  W !
  1.  ;S DIR(0)="Y"  ;abm*2.6*6 5010
  1.  S DIR(0)="S^Y:YES;N:NO;W:Patient refuses to assign benefits"  ;abm*2.6*6 5010
  1.  S DIR("A")="["_ABM("#")_"] Was ASSIGNMENT OF BENEFITS Obtained"
  1.  S DIR("?")="Is a Signed Statement for Assignment of Benefits on File"
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)]"" S DIR("B")=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,5)="Y":"Y",1:"N")
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  S ABM("Y")=Y
  1.  ;start old code abm*2.6*6 5010
  1.  ;I Y=0 D N2 Q
  1.  ;D Y2
  1.  ;end old code start new code 5010
  1.  I Y="N" D N2 Q
  1.  I Y="Y" D Y2 Q
  1.  I Y="W" D W2
  1.  ;end new code 5010
  1.  Q
  1. Y2 ; EP
  1.  S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".75////Y;.712R~Assignment Obtained Date.." D ^DIE K DR
  1.  Q
  1. N2 ;
  1.  S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".75////N;.712////@" D ^DIE K DR
  1.  Q
  1.  ;start new code abm*2.6*6 5010
  1. W2 ;
  1.  S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".75////W;.712////@" D ^DIE K DR
  1.  Q
  1.  ;end new code 5010
  1.  ;
  1. 3 W ! S DIR(0)="Y",DIR("A")="["_ABM("#")_"] Was the Visit Related to an Accident",DIR("?")="Was the Purpose of the Visit Associated with an Accident"
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),($P(^(8),U,2)]""!($P(^(8),U,3)]"")) 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 ACTYPE
  1.  ;abm*2.6*14 HEAT165301 put back below original code to remove link from page 9A
  1.  ;start old code abm*2.6*13 exp mode 35
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)'=""!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)'="") D
  1.  .;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)'="" D
  1.  .;.S DA(1)=ABMP("CDFN")
  1.  .;.S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
  1.  .;.S DA=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)
  1.  .;.D ^DIK
  1.  .S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
  1.  .S DR=".82////@;.83////@;.84////@"
  1.  .D ^DIE K DR
  1.  ;end old start new exp mode 35
  1.  ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)'=""!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)'="") D
  1.  ;.S ABMTEST=+$O(^ABMDCODE("AC","O","01",0))
  1.  ;.S ABMI=0
  1.  ;.F  S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMI)) Q:'ABMI  D
  1.  ;..I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMI,0)),U)'=ABMTEST Q
  1.  ;..D ^XBFMK
  1.  ;..S DA(1)=ABMP("CDFN")
  1.  ;..S DA=ABMI
  1.  ;..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
  1.  ;..D ^DIK
  1.  ;.;
  1.  ;.S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
  1.  ;.S DR=".82////@;.83////@;.84////@"
  1.  ;.S DR=DR_";.86////@;.816////@"
  1.  ;.D ^DIE K DR
  1.  ;end new exp mode 35
  1.  Q
  1.  ;
  1. ACTYPE S DIR(0)="SO^1:AUTO ACCIDENT;2:AUTO-NO FAULT INSURANCE INVOLVED;3:COURT ACTION POSSIBLE;5:OTHER ACCIDENT",DIR("A")="Type of Accident"
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),$P(^(8),U,3)]"" S DIR("B")=$P(^(8),U,3)
  1.  D ^DIR K DIR
  1.  Q:$D(DUOUT)!$D(DIROUT)!$D(DTOUT)
  1.  I Y="" S Y=5
  1.  S ABM("Y")=Y
  1.  S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".83///"_Y D ^DIE K DR
  1.  ;
  1. ACDT K DIR W ! S DIR(0)="D^:"_ABMP("VDT")_":EX",DIR("A")="Accident Date",DIR("?")="Enter the date the accident occurred that necessitated treatment"
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)]"" S DIR("B")=$$SDT^ABMDUTL($P(^(8),U,2))
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)=""&($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,6)'="") S DIR("B")=$$SDT^ABMDUTL($P(^(8),U,6))  ;abm*2.6*12 exp mode 35
  1.  D ^DIR K DIR Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
  1.  ;S ABM("X")=Y  ;abm*2.6*13 accident date
  1.  S (ABM("X"),ABMP("ACDT"))=Y  ;abm*2.6*13 accident date
  1.  S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".82///"_Y D ^DIE K DR
  1.  ;
  1. ACHR W ! S DIR(0)="NO^0:23",DIR("A")="Accident Hour",DIR("?")="Enter the hour the accident occurred that necessitated treatment" I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,4)]"",$P(^(8),U,4)<24,$P(^(8),U,4)>-1 S DIR("B")=$P(^(8),U,4)
  1.  D ^DIR K DIR
  1.  S:X="" Y=99
  1.  S:X="@" Y="@"  ;delete hour/ will drop error ;abm*2.6*13 HEAT72979
  1.  S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".84////"_Y D ^DIE K DR
  1. ACST S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".816" D ^DIE K DR
  1.  ;
  1. ACCODE ;EP - Entry Point for setting UB-82 Accident Code
  1.  ;start old code abm*2.6*13 exp mode 35
  1.  ;I $L(ABM("Y"))=1 S ABM("Y")="0"_ABM("Y")
  1.  ;S (DINUM,X)=$O(^ABMDCODE("AC","O",ABM("Y"),"")) G ACHR:X=""
  1.  ;K DD,DO
  1.  ;S DA(1)=ABMP("CDFN")
  1.  ;S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
  1.  ;S DIC(0)="LE"
  1.  ;S DIC("DR")=".02////"_ABM("X")
  1.  ;I '$D(^ABMDCLM(DUZ(2),DA(1),51,0)) S ^ABMDCLM(DUZ(2),DA(1),51,0)="^9002274.3051P^^"
  1.  ;D FILE^DICN
  1.  ;end old start new exp mode 35
  1.  ;
  1.  ;start old abm*2.6*15 HEAT165301
  1.  ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)="" Q
  1.  ;K ABMTEST,ABMI
  1.  ;D ^XBFMK
  1.  ;S DA(1)=ABMP("CDFN")
  1.  ;S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",51,"
  1.  ;S DIC("P")=$P(^DD(9002274.3,51,0),U,2)
  1.  ;S X="`"_+$O(^ABMDCODE("AC","O","01",0))
  1.  ;G ACHR:X=""
  1.  ;S DIC(0)="ML"
  1.  ;K DD,DO
  1.  ;D ^DIC
  1.  ;S DIE=DIC
  1.  ;S DA=+Y
  1.  ;S DR=".02////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)
  1.  ;D ^DIE
  1.  ;end old HEAT165301
  1.  ;end new exp mode 35
  1.  Q
  1.  ;
  1. XIT Q