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