ABMDE3B ; IHS/ASDST/DMJ - Edit Page 3 - QUESTIONS - part 3 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p10 - IM20076
; Added EPSDT referral
;
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"
I $P(ABMP("C0"),U,6)]"",$D(^DIC(40.7,$P(ABMP("C0"),U,6),0)),$P(^(0),U)["EMERGENCY" S DIR("B")="Y"
E I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),$P(^(8),U,5)="Y" S DIR("B")="Y"
I '$D(DIR("B")) S DIR("B")="N"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I Y=1 G ASET
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
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
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
Q
ASET ;EP - Entry Point for setting Emergency Room charge
S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".85///Y"
D ^DIE K DR
;
ASRC I $P(ABMP("C0"),U,7)'=111 Q
I $P($G(^ABMDCODE(ABMP("CDFN"),5)),U,2)'="" G ATYP
S X=$O(^ABMDCODE("AC","A",7,"")) G ATYP:X=""
S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".52////"_X D ^DIE K DR
;
ATYP S X=$O(^ABMDCODE("AC","T",1,"")) Q:X=""
I $P($G(^ABMDCODE(ABMP("CDFN"),5)),U,1)'="" Q
S DA=ABMP("CDFN"),DIE="^ABMDCLM(DUZ(2),",DR=".51////"_X D ^DIE K DR
Q
;
6 ; Special Program
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"
I $O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))]"" S DIR("B")="Y"
E S DIR("B")="N"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I Y=1 G SPPROG
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
Q
;
SPPROG K DIC
K X,Y
S ABM("DICS")="9002274.3059" X:$D(^DD(ABM("DICS"),.01,12.1)) ^DD(ABM("DICS"),.01,12.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)
W ! S DIC="^ABMDCODE(",DIC(0)="QEAM" S DIC("A")="Select SPECIAL PROGRAM: " D ^DIC K DIC
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(X="")
I +Y<1 G 6
SP ;EP - Entry Point for setting UB-82 Special Prog code
S ABM("Y")=+Y
S DA(1)=ABMP("CDFN")
I +$O(^ABMDCLM(DUZ(2),DA(1),59,0))=0 S DIC("P")=$P(^DD(9002274.3,59,0),U,2)
I +$O(^ABMDCLM(DUZ(2),DA(1),59,0))'=0 D
.S ABM("X")=$O(^ABMDCLM(DUZ(2),DA(1),59,0))
.I ABM("X")]"" D
..K DIR,X,Y
..S DIR(0)="Y"
..S DIR("A")="Info in EPSDT fields. Ok to delete?"
..S DIR("B")="Y"
..D ^DIR K DIR
..S ABMANS=+Y
..Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
..I ABMANS>0 S DA=ABM("X"),DIK="^ABMDCLM(DUZ(2),"_DA(1)_",59," D ^DIK
I +$O(^ABMDCLM(DUZ(2),DA(1),59,0))'=0,(+$G(ABMANS)<1) Q
S (DINUM,X)=ABM("Y")
K DD,DO S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",59,",DIC(0)="LE"
D FILE^DICN K DIC
;EPSDT referral?
S (DA,ABMPSCD)=+Y
S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",59,"
S DR=".02"
D ^DIE
;If referral, up to 3 reasons
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABMPSCD,0)),U,2)="Y" D ;referral reason
.F ABMX=1:1:3 D Q:(+Y<0)!($D(DTOUT))!($D(DUOUT))
..K DIC,DIE,DA,DR,X,Y
..S DA(2)=ABMP("CDFN")
..S DA(1)=ABMPSCD
..S DIC="^ABMDCLM(DUZ(2),"_DA(2)_",59,"_DA(1)_",1,"
..S DIC(0)="AEMLQ"
..S DIC("P")=$P(^DD(9002274.3059,".03",0),U,2)
..S DIC("A")="Select referral reason(s):"
..D ^DIC
..I $P(Y,U,3)'=1 S ABMX=ABMX-1
Q
;
7 ; Outside Lab Charges
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"
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),$P(^(8),U,1)]"" S DIR("B")=$P(^(8),U)
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I X'="" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".81////"_Y D ^DIE K DR
Q
;
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"
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),$P(^(7),U,6)>0 S DIR("B")="Y"
E S DIR("B")="N"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I Y=0 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".76///@;.77///@;.78///@;.79///@" D ^DIE K DR Q
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".76T;.77T;.78T;.79T" D ^DIE K DR
Q
;
XIT Q
ABMDE3B ; IHS/ASDST/DMJ - Edit Page 3 - QUESTIONS - part 3 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p10 - IM20076
+4 ; Added EPSDT referral
+5 ;
5 WRITE !
SET DIR(0)="Y"
SET DIR("A")="["_ABM("#")_"] Was Visit an Emergency"
SET DIR("?")="If Emergency Room Utilized as a result of Condition of Medical Severity"
+1 IF $PIECE(ABMP("C0"),U,6)]""
IF $DATA(^DIC(40.7,$PIECE(ABMP("C0"),U,6),0))
IF $PIECE(^(0),U)["EMERGENCY"
SET DIR("B")="Y"
+2 IF '$TEST
IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
IF $PIECE(^(8),U,5)="Y"
SET DIR("B")="Y"
+3 IF '$DATA(DIR("B"))
SET DIR("B")="N"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+6 IF Y=1
GOTO ASET
+7 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
IF $PIECE(^(8),U,5)="Y"
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".85///@;.855///@"
DO ^DIE
KILL DR
+8 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),5))
IF $PIECE(^(5),U,1)=$ORDER(^ABMDCODE("AC","T",1,""))
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".51///@"
DO ^DIE
KILL DR
+9 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),5))
IF $PIECE(^(5),U,2)=$ORDER(^ABMDCODE("AC","A",7,""))
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".52///@"
DO ^DIE
KILL DR
+10 QUIT
ASET ;EP - Entry Point for setting Emergency Room charge
+1 SET DA=ABMP("CDFN")
SET DIE="^ABMDCLM(DUZ(2),"
SET DR=".85///Y"
+2 DO ^DIE
KILL DR
+3 ;
ASRC IF $PIECE(ABMP("C0"),U,7)'=111
QUIT
+1 IF $PIECE($GET(^ABMDCODE(ABMP("CDFN"),5)),U,2)'=""
GOTO ATYP
+2 SET X=$ORDER(^ABMDCODE("AC","A",7,""))
IF X=""
GOTO ATYP
+3 SET DA=ABMP("CDFN")
SET DIE="^ABMDCLM(DUZ(2),"
SET DR=".52////"_X
DO ^DIE
KILL DR
+4 ;
ATYP SET X=$ORDER(^ABMDCODE("AC","T",1,""))
IF X=""
QUIT
+1 IF $PIECE($GET(^ABMDCODE(ABMP("CDFN"),5)),U,1)'=""
QUIT
+2 SET DA=ABMP("CDFN")
SET DIE="^ABMDCLM(DUZ(2),"
SET DR=".51////"_X
DO ^DIE
KILL DR
+3 QUIT
+4 ;
6 ; Special Program
+1 WRITE !
SET DIR(0)="Y"
SET DIR("A")="["_ABM("#")_"] Was visit related to a SPECIAL PROGRAM"
SET DIR("?")="If services provided to patient were related to a Special Program"
+2 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))]""
SET DIR("B")="Y"
+3 IF '$TEST
SET DIR("B")="N"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+6 IF Y=1
GOTO SPPROG
+7 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))]""
SET DA(1)=ABMP("CDFN")
SET ABM("X")=$ORDER(^ABMDCLM(DUZ(2),DA(1),59,0))
IF ABM("X")]""
SET DA=ABM("X")
SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",59,"
DO ^DIK
+8 QUIT
+9 ;
SPPROG KILL DIC
+1 KILL X,Y
+2 SET ABM("DICS")="9002274.3059"
IF $DATA(^DD(ABM("DICS"),.01,12.1))
XECUTE ^DD(ABM("DICS"),.01,12.1)
+3 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),59))=10
SET ABM("X")=$ORDER(^(59,0))
IF ABM("X")]""
IF $DATA(^(ABM("X"),0))
SET ABM("X")=^(0)
IF $DATA(^ABMDCODE(ABM("X"),0))
SET DIC("B")=$PIECE(^(0),U,1)
+4 WRITE !
SET DIC="^ABMDCODE("
SET DIC(0)="QEAM"
SET DIC("A")="Select SPECIAL PROGRAM: "
DO ^DIC
KILL DIC
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(X="")
QUIT
+6 IF +Y<1
GOTO 6
SP ;EP - Entry Point for setting UB-82 Special Prog code
+1 SET ABM("Y")=+Y
+2 SET DA(1)=ABMP("CDFN")
+3 IF +$ORDER(^ABMDCLM(DUZ(2),DA(1),59,0))=0
SET DIC("P")=$PIECE(^DD(9002274.3,59,0),U,2)
+4 IF +$ORDER(^ABMDCLM(DUZ(2),DA(1),59,0))'=0
Begin DoDot:1
+5 SET ABM("X")=$ORDER(^ABMDCLM(DUZ(2),DA(1),59,0))
+6 IF ABM("X")]""
Begin DoDot:2
+7 KILL DIR,X,Y
+8 SET DIR(0)="Y"
+9 SET DIR("A")="Info in EPSDT fields. Ok to delete?"
+10 SET DIR("B")="Y"
+11 DO ^DIR
KILL DIR
+12 SET ABMANS=+Y
+13 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+14 IF ABMANS>0
SET DA=ABM("X")
SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",59,"
DO ^DIK
End DoDot:2
End DoDot:1
+15 IF +$ORDER(^ABMDCLM(DUZ(2),DA(1),59,0))'=0
IF (+$GET(ABMANS)<1)
QUIT
+16 SET (DINUM,X)=ABM("Y")
+17 KILL DD,DO
SET DA(1)=ABMP("CDFN")
SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",59,"
SET DIC(0)="LE"
+18 DO FILE^DICN
KILL DIC
+19 ;EPSDT referral?
+20 SET (DA,ABMPSCD)=+Y
+21 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",59,"
+22 SET DR=".02"
+23 DO ^DIE
+24 ;If referral, up to 3 reasons
+25 ;referral reason
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABMPSCD,0)),U,2)="Y"
Begin DoDot:1
+26 FOR ABMX=1:1:3
Begin DoDot:2
+27 KILL DIC,DIE,DA,DR,X,Y
+28 SET DA(2)=ABMP("CDFN")
+29 SET DA(1)=ABMPSCD
+30 SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_",59,"_DA(1)_",1,"
+31 SET DIC(0)="AEMLQ"
+32 SET DIC("P")=$PIECE(^DD(9002274.3059,".03",0),U,2)
+33 SET DIC("A")="Select referral reason(s):"
+34 DO ^DIC
+35 IF $PIECE(Y,U,3)'=1
SET ABMX=ABMX-1
End DoDot:2
IF (+Y<0)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
End DoDot:1
+36 QUIT
+37 ;
7 ; Outside Lab Charges
+1 WRITE !
SET DIR(0)="NO^0:999.99:2"
SET DIR("A")="["_ABM("#")_"] Outside Lab Charges"
SET DIR("?")="Enter the Amount of Lab Charges that occurred Outside IHS"
+2 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),8))
IF $PIECE(^(8),U,1)]""
SET DIR("B")=$PIECE(^(8),U)
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+5 IF X'=""
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".81////"_Y
DO ^DIE
KILL DR
+6 QUIT
+7 ;
8 WRITE !
SET DIR(0)="YO"
SET DIR("A")="["_ABM("#")_"] Was BLOOD Furnished (Y/N)"
SET DIR("?")="If whole blood or units of packed red cells furnished to patient"
+1 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),7))
IF $PIECE(^(7),U,6)>0
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=0
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".76///@;.77///@;.78///@;.79///@"
DO ^DIE
KILL DR
QUIT
+6 SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
SET DR=".76T;.77T;.78T;.79T"
DO ^DIE
KILL DR
+7 QUIT
+8 ;
XIT QUIT
