- 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
