ABMDE7C.m

ABMDE7C ; IHS/ASDST/DMJ - Page 7 - Inpatient Triggers ;   

 ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009

 ;

 ; IHS/ASDS/LSL - 11/01/01 - V2.4 P9  - Resolve undef error when splitting claims.

 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI

 ; *********************************************************************

 ;

 ; If it gets this far w/o active insurer, ABMP("FEE") is undefined

 S:'$D(ABMP("FEE")) ABMP("FEE")=$P($G(^ABMDPARM(DUZ(2),1,0)),U,9)

TRIG S ABM("C6")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),ABM("C5")=$G(^(5)),ABM("C7")=$G(^(7))

 G RB:+ABM("C5")'=85

FLAT2 I $D(ABMP("FLAT")),$P(ABM("C5"),U,10)>0 S ABMP("FLAT",170)=$P(ABM("C5"),U,10)

 G COMP:ABMP("PAGE")'[8

 ;

RB I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)),$P(ABM("C7"),U,3)>0 D

 .Q:ABMP("VTYP")=831

 .Q:ABMP("VTYP")=999

 .S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",25,",DIC(0)="LXE"

 .S ^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)="^9002274.3025P"

 .;S (DINUM,X)=120,DIC("DR")=".02////"_$P(ABM("C7"),U,3)_";.03////"_$P($G(^ABMDFEE(ABMP("FEE"),31,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 .S (DINUM,X)=120,DIC("DR")=".02////"_$P(ABM("C7"),U,3)_";.03////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 ;

NURS G NONUR:+ABM("C5")'=85

 I '$D(ABMP("FLAT")),ABMP("VTYP")'=831 D

 .Q:$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0))

 .S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",25,",DIC(0)="LE"

 .;I $P(ABM("C5"),U,10)>0 S (DINUM,X)=170,DIC("DR")=".02////"_$P(ABM("C5"),U,10)_";.03////"_$P($G(^ABMDFEE(ABMP("FEE"),31,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 .I $P(ABM("C5"),U,10)>0 S (DINUM,X)=170,DIC("DR")=".02////"_$P(ABM("C5"),U,10)_";.03////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 G COMP

 ;

NONUR I $P(ABM("C5"),U,10)]"" S DA=ABMP("CDFN"),DR=".525///@",DIE="^ABMDCLM(DUZ(2)," D ^DIE

 I $D(ABMP("FLAT")) K ABMP("FLAT",2)

 I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,170))=10 S DA(1)=ABMP("CDFN"),DIK="^ABMDCLM(DUZ(2),"_DA(1)_",25,",DA=170 D ^DIK

 ;

COMP ;COMP LINE TAG

 ;

PSRO S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")

 ;

MED Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0))

 S ^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0)="^9002274.3027P"

 S DA(1)=ABMP("CDFN")

 S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,",DIC(0)="LE"

 S (DINUM,X)=$S($D(^ICPT(99221)):99221,1:90200)

 ;S DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2)  ;abm*2.6*2 3PMS10003A

 S DIC("DR")=".03////1;.04////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A

 K DD,DO D FILE^DICN

 ;I $P(ABM("C7"),U,3)>1 S (X,DINUM)=$S($D(^ICPT(99231)):99231,1:90240),DIC("DR")=".03////"_($P(ABM("C7"),U,3)-1)_";.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 I $P(ABM("C7"),U,3)>1 S (X,DINUM)=$S($D(^ICPT(99231)):99231,1:90240),DIC("DR")=".03////"_($P(ABM("C7"),U,3)-1)_";.04////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 ;I $P(ABM("C7"),U,2)>$P(ABM("C7"),U) S (X,DINUM)=$S($D(^ICPT(99238)):99238,1:90292),DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 I $P(ABM("C7"),U,2)>$P(ABM("C7"),U) S (X,DINUM)=$S($D(^ICPT(99238)):99238,1:90292),DIC("DR")=".03////1;.04////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 Q

ABMDE7C   ; IHS/ASDST/DMJ - Page 7 - Inpatient Triggers ;   

 +1       ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009

 +2       ;

 +3       ; IHS/ASDS/LSL - 11/01/01 - V2.4 P9  - Resolve undef error when splitting claims.

 +4       ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI

 +5       ; *********************************************************************

 +6       ;

 +7       ; If it gets this far w/o active insurer, ABMP("FEE") is undefined

 +8        IF '$DATA(ABMP("FEE"))

               SET ABMP("FEE")=$PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,9)

TRIG       SET ABM("C6")=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),6))

           SET ABM("C5")=$GET(^(5))

           SET ABM("C7")=$GET(^(7))

 +1        IF +ABM("C5")'=85

               GOTO RB

FLAT2      IF $DATA(ABMP("FLAT"))

               IF $PIECE(ABM("C5"),U,10)>0

                   SET ABMP("FLAT",170)=$PIECE(ABM("C5"),U,10)

 +1        IF ABMP("PAGE")'[8

               GOTO COMP

 +2       ;

RB         IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0))

               IF $PIECE(ABM("C7"),U,3)>0

                   Begin DoDot:1

 +1                    IF ABMP("VTYP")=831

                           QUIT 

 +2                    IF ABMP("VTYP")=999

                           QUIT 

 +3                    SET DA(1)=ABMP("CDFN")

                       SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",25,"

                       SET DIC(0)="LXE"

 +4                    SET ^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)="^9002274.3025P"

 +5       ;S (DINUM,X)=120,DIC("DR")=".02////"_$P(ABM("C7"),U,3)_";.03////"_$P($G(^ABMDFEE(ABMP("FEE"),31,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 +6       ;abm*2.6*2 3PMS10003A

                       SET (DINUM,X)=120

                       SET DIC("DR")=".02////"_$PIECE(ABM("C7"),U,3)_";.03////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U)

                       KILL DD,DO

                       DO FILE^DICN

                   End DoDot:1

 +7       ;

NURS       IF +ABM("C5")'=85

               GOTO NONUR

 +1        IF '$DATA(ABMP("FLAT"))

               IF ABMP("VTYP")'=831

                   Begin DoDot:1

 +2                    IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0))

                           QUIT 

 +3                    SET DA(1)=ABMP("CDFN")

                       SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",25,"

                       SET DIC(0)="LE"

 +4       ;I $P(ABM("C5"),U,10)>0 S (DINUM,X)=170,DIC("DR")=".02////"_$P(ABM("C5"),U,10)_";.03////"_$P($G(^ABMDFEE(ABMP("FEE"),31,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 +5       ;abm*2.6*2 3PMS10003A

                       IF $PIECE(ABM("C5"),U,10)>0

                           SET (DINUM,X)=170

                           SET DIC("DR")=".02////"_$PIECE(ABM("C5"),U,10)_";.03////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U)

                           KILL DD,DO

                           DO FILE^DICN

                   End DoDot:1

 +6        GOTO COMP

 +7       ;

NONUR      IF $PIECE(ABM("C5"),U,10)]""

               SET DA=ABMP("CDFN")

               SET DR=".525///@"

               SET DIE="^ABMDCLM(DUZ(2),"

               DO ^DIE

 +1        IF $DATA(ABMP("FLAT"))

               KILL ABMP("FLAT",2)

 +2        IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,170))=10

               SET DA(1)=ABMP("CDFN")

               SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",25,"

               SET DA=170

               DO ^DIK

 +3       ;

COMP      ;COMP LINE TAG

 +1       ;

PSRO       SET DIE="^ABMDCLM(DUZ(2),"

           SET DA=ABMP("CDFN")

 +1       ;

MED        IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0))

               QUIT 

 +1        SET ^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0)="^9002274.3027P"

 +2        SET DA(1)=ABMP("CDFN")

 +3        SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,"

           SET DIC(0)="LE"

 +4        SET (DINUM,X)=$SELECT($DATA(^ICPT(99221)):99221,1:90200)

 +5       ;S DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2)  ;abm*2.6*2 3PMS10003A

 +6       ;abm*2.6*2 3PMS10003A

           SET DIC("DR")=".03////1;.04////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)

 +7        KILL DD,DO

           DO FILE^DICN

 +8       ;I $P(ABM("C7"),U,3)>1 S (X,DINUM)=$S($D(^ICPT(99231)):99231,1:90240),DIC("DR")=".03////"_($P(ABM("C7"),U,3)-1)_";.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 +9       ;abm*2.6*2 3PMS10003A

           IF $PIECE(ABM("C7"),U,3)>1

               SET (X,DINUM)=$SELECT($DATA(^ICPT(99231)):99231,1:90240)

               SET DIC("DR")=".03////"_($PIECE(ABM("C7"),U,3)-1)_";.04////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)

               KILL DD,DO

               DO FILE^DICN

 +10      ;I $P(ABM("C7"),U,2)>$P(ABM("C7"),U) S (X,DINUM)=$S($D(^ICPT(99238)):99238,1:90292),DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2) K DD,DO D FILE^DICN  ;abm*2.6*2 3PMS10003A

 +11      ;abm*2.6*2 3PMS10003A

           IF $PIECE(ABM("C7"),U,2)>$PIECE(ABM("C7"),U)

               SET (X,DINUM)=$SELECT($DATA(^ICPT(99238)):99238,1:90292)

               SET DIC("DR")=".03////1;.04////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)

               KILL DD,DO

               DO FILE^DICN

 +12       QUIT