ABMDVST6.m

ABMDVST6 ; IHS/ASDST/DMJ - PCC VISIT STUFF - DENTAL ; 

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

 ;Original;TMD;03/26/96 10:50 AM

 ;

 ;IHS/DSD/JLG - 05/21/98 -  NOIS NCA-0598-180077

 ;            Modified to set corresponding diagnosis if only one POV

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

 ;

 Q:$D(ABMP("DENTDONE"))

 Q:'$D(^AUPNVDEN("AD",ABMVDFN))

 Q:$P($G(^AUTNINS(ABMP("INS"),2)),U,5)="U"

DEN D CLEAN^ABMDVST4(33)

 S ABMP("DENTDONE")=1

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

 S ABM("HIT")=0

 S ABM=""

 F  S ABM=$O(^AUPNVDEN("AD",ABMVDFN,ABM)) Q:'ABM  D

 .K DD,DO,DIC("DR") D DENCHK

 I ABM("HIT"),$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7)'=998 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".07////998" D ^DIE K DR

 K DIC,ABMR,DIE,DR

 Q

 ;

DENCHK Q:'$D(^AUPNVDEN(ABM,0))  S ABMR("OPSITE")=$P(^(0),U,5),ABMR("SURF")=$P(^(0),U,6),X=$P(^(0),U),ABMR("UNIT")=$P($G(^(0)),U,4)

 S ABMR("CODE")=$P($G(^AUTTADA(+X,0)),U)

TEST I ABMR("CODE")]"" D  Q:'X

 .S ABMR("DA1")=$S($D(^ABMDREC(ABMP("INS"),1,"B",ABMR("CODE"))):ABMP("INS"),1:99999)

 .Q:'$D(^ABMDREC(ABMR("DA1"),1,"B",ABMR("CODE")))

 .S ABMR("IEN")=$O(^ABMDREC(ABMR("DA1"),1,"B",ABMR("CODE"),0))

 .S ABMR("CODE")=$P(^ABMDREC(ABMR("DA1"),1,ABMR("IEN"),0),"^",2)

 .Q:ABMR("CODE")=""

 .S X=$O(^AUTTADA("B",ABMR("CODE"),0))

 ;S ABM("CHRG")=$P($G(^ABMDFEE(ABMP("FEE"),21,1_ABMR("CODE"),0)),"^",2)  ;abm*2.6*2 3PMS10003A

 S ABM("CHRG")=$P($$ONE^ABMFEAPI(ABMP("FEE"),21,1_ABMR("CODE"),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A

 ;Q:'ABM("CHRG")

 I ($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"),('ABM("CHRG")) Q

 S ABMSRC="05|"_ABM_"|DEN"

 S ABM("HIT")=1

 S DIC("P")=$P(^DD(9002274.3,33,0),U,2)

 ;S DIC("DR")=".02////510;.05////"_ABMR("OPSITE")_";.06////"_ABMR("SURF")_";.07////"_ABMCHVDT_";.08////"_ABM("CHRG")_";.09////"_ABMR("UNIT")  ;abm*2.6*11 IHS/SD/AML HEAT92863

 S DIC("DR")=".02////512;.05////"_ABMR("OPSITE")_";.06////"_ABMR("SURF")_";.07////"_ABMCHVDT_";.08////"_ABM("CHRG")_";.09////"_ABMR("UNIT")  ;abm*2.6*11 IHS/SD/AML HEAT92863 Dental Revenue Code

 ;Next line set correspond diagnosis if only 1 POV  

 I $D(ABMP("CORRSDIAG")) S DIC("DR")=DIC("DR")_";.04////1"

 S DIC("DR")=DIC("DR")_";.17////"_ABMSRC

 K DD,DO

 K DD,DO D FILE^DICN

 Q

ABMDVST6  ; IHS/ASDST/DMJ - PCC VISIT STUFF - DENTAL ; 

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

 +2       ;Original;TMD;03/26/96 10:50 AM

 +3       ;

 +4       ;IHS/DSD/JLG - 05/21/98 -  NOIS NCA-0598-180077

 +5       ;            Modified to set corresponding diagnosis if only one POV

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

 +7       ;

 +8        IF $DATA(ABMP("DENTDONE"))

               QUIT 

 +9        IF '$DATA(^AUPNVDEN("AD",ABMVDFN))

               QUIT 

 +10       IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,5)="U"

               QUIT 

DEN        DO CLEAN^ABMDVST4(33)

 +1        SET ABMP("DENTDONE")=1

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

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

           SET DIC(0)="LE"

 +3        SET ABM("HIT")=0

 +4        SET ABM=""

 +5        FOR 

               SET ABM=$ORDER(^AUPNVDEN("AD",ABMVDFN,ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +6                KILL DD,DO,DIC("DR")

                   DO DENCHK

               End DoDot:1

 +7        IF ABM("HIT")

               IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7)'=998

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

                   SET DA=ABMP("CDFN")

                   SET DR=".07////998"

                   DO ^DIE

                   KILL DR

 +8        KILL DIC,ABMR,DIE,DR

 +9        QUIT 

 +10      ;

DENCHK     IF '$DATA(^AUPNVDEN(ABM,0))

               QUIT 

           SET ABMR("OPSITE")=$PIECE(^(0),U,5)

           SET ABMR("SURF")=$PIECE(^(0),U,6)

           SET X=$PIECE(^(0),U)

           SET ABMR("UNIT")=$PIECE($GET(^(0)),U,4)

 +1        SET ABMR("CODE")=$PIECE($GET(^AUTTADA(+X,0)),U)

TEST       IF ABMR("CODE")]""

               Begin DoDot:1

 +1                SET ABMR("DA1")=$SELECT($DATA(^ABMDREC(ABMP("INS"),1,"B",ABMR("CODE"))):ABMP("INS"),1:99999)

 +2                IF '$DATA(^ABMDREC(ABMR("DA1"),1,"B",ABMR("CODE")))

                       QUIT 

 +3                SET ABMR("IEN")=$ORDER(^ABMDREC(ABMR("DA1"),1,"B",ABMR("CODE"),0))

 +4                SET ABMR("CODE")=$PIECE(^ABMDREC(ABMR("DA1"),1,ABMR("IEN"),0),"^",2)

 +5                IF ABMR("CODE")=""

                       QUIT 

 +6                SET X=$ORDER(^AUTTADA("B",ABMR("CODE"),0))

               End DoDot:1

               IF 'X

                   QUIT 

 +7       ;S ABM("CHRG")=$P($G(^ABMDFEE(ABMP("FEE"),21,1_ABMR("CODE"),0)),"^",2)  ;abm*2.6*2 3PMS10003A

 +8       ;abm*2.6*2 3PMS10003A

           SET ABM("CHRG")=$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),21,1_ABMR("CODE"),ABMP("VDT")),U)

 +9       ;Q:'ABM("CHRG")

 +10       IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")

               IF ('ABM("CHRG"))

                   QUIT 

 +11       SET ABMSRC="05|"_ABM_"|DEN"

 +12       SET ABM("HIT")=1

 +13       SET DIC("P")=$PIECE(^DD(9002274.3,33,0),U,2)

 +14      ;S DIC("DR")=".02////510;.05////"_ABMR("OPSITE")_";.06////"_ABMR("SURF")_";.07////"_ABMCHVDT_";.08////"_ABM("CHRG")_";.09////"_ABMR("UNIT")  ;abm*2.6*11 IHS/SD/AML HEAT92863

 +15      ;abm*2.6*11 IHS/SD/AML HEAT92863 Dental Revenue Code

           SET DIC("DR")=".02////512;.05////"_ABMR("OPSITE")_";.06////"_ABMR("SURF")_";.07////"_ABMCHVDT_";.08////"_ABM("CHRG")_";.09////"_ABMR("UNIT")

 +16      ;Next line set correspond diagnosis if only 1 POV  

 +17       IF $DATA(ABMP("CORRSDIAG"))

               SET DIC("DR")=DIC("DR")_";.04////1"

 +18       SET DIC("DR")=DIC("DR")_";.17////"_ABMSRC

 +19       KILL DD,DO

 +20       KILL DD,DO

           DO FILE^DICN

 +21       QUIT