ABMDAST3.m

ABMDAST3 ; IHS/ASDST/DMJ - ACC VISIT STUFF - PART 4 ; 

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

 ;

 ; IHS/SD/SDR - v2.6 CSV

 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to use ABMFEAPI

 ;

 S ABM("NAR")=""

PRC I +$P($G(^AAPCRCDS(ABMP("VDFN"),4)),U,13) S ABM("X")=$P(^(4),U,13) D PRCCHK

 G CPT

 ;

PRCCHK Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0))

 S ABM("P")=1,X=$P($$ICDOP^ABMCVAPI(ABM("X"),ABMP("VDT")),U,5)  ;CSV-c

 S (DIC,DLAYGO)=9999999.27,DIC(0)="XL" D ^DIC Q:Y<0  S ABM("NAR")=+Y

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

 I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM("P")))=10 S ABM="" F  S ABM=$O(^(ABM)) Q:ABM=""  S ABM("P")=ABM+1

 S (DINUM,X)=ABM("X") K DD,DO

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

 S DIC("DR")=".02////"_ABM("P")_";.03////"_ABMP("VDT")_";.04////"_ABM("NAR") K DD,DO D FILE^DICN

 Q

 ;

CPT S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",21,",DIC(0)="LE" K DD,DO

 I +$P($G(^AAPCRCDS(ABMP("VDFN"),4)),U,13) S ABM("X")=$P(^(4),U,13) D CPTCHK

 G ^ABMDAST4

 ;

CPTCHK Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),0))

 S ABM("CPT")=""

CLOOP S ABM("CPT")=$O(^ICPT("I",ABM("X"),ABM("CPT"))) I ABM("CPT")="" S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=".41////Y" D ^DIE K DR Q

 ;G CLOOP:$P($$CPT^ABMCVAPI(ABM("CPT",ABMP("VDT"))),U,7)!($P($G(^ABMDFEE(ABMP("FEE"),11,ABM("CPT"),0)),U,2)'>0)  ;CSV-c  ;abm*2.6*2 3PMS10003A

 G CLOOP:$P($$CPT^ABMCVAPI(ABM("CPT",ABMP("VDT"))),U,7)!($P($$ONE^ABMFEAPI(ABMP("FEE"),11,ABM("CPT"),ABMP("VDT")),U)'>0)  ;CSV-c  ;abm*2.6*2 3PMS10003A

 S:$O(^ICPT("I",ABM("X"),ABM("CPT")))'="" ABMR("DUP")=1

 Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"B",ABM("CPT")))=10

 S ABM("P")=1 I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM("P")))=10 S ABM="" F  S ABM=$O(^(ABM)) Q:ABM=""  S ABM("P")=ABM+1

 S X=ABM("CPT")

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

 S DIC("DR")=".02////"_ABM("P")_";.05////"_ABMP("VDT")_";.06////"_ABM("NAR")

 S:$G(ABMR("DUP"))=1 DIC("DR")=DIC("DR")_";.08////Y" K DD,DO D FILE^DICN

 I ABM("CPT")<59400!ABM("CPT")>59529 Q

DELIV I ABM("CPT")<59500 S:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)) ^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)="^9002274.3025P" S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",25,",DIC(0)="LE"

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

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

CESEAR I ABM("CPT")>59499 S:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)) ^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)="^9002274.3025P" S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",25,",DIC(0)="LE"

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

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

 Q

ABMDAST3  ; IHS/ASDST/DMJ - ACC VISIT STUFF - PART 4 ; 

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

 +2       ;

 +3       ; IHS/SD/SDR - v2.6 CSV

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

 +5       ;

 +6        SET ABM("NAR")=""

PRC        IF +$PIECE($GET(^AAPCRCDS(ABMP("VDFN"),4)),U,13)

               SET ABM("X")=$PIECE(^(4),U,13)

               DO PRCCHK

 +1        GOTO CPT

 +2       ;

PRCCHK     IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0))

               QUIT 

 +1       ;CSV-c

           SET ABM("P")=1

           SET X=$PIECE($$ICDOP^ABMCVAPI(ABM("X"),ABMP("VDT")),U,5)

 +2        SET (DIC,DLAYGO)=9999999.27

           SET DIC(0)="XL"

           DO ^DIC

           IF Y<0

               QUIT 

           SET ABM("NAR")=+Y

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

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

           SET DIC(0)="LE"

 +4        IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM("P")))=10

               SET ABM=""

               FOR 

                   SET ABM=$ORDER(^(ABM))

                   IF ABM=""

                       QUIT 

                   SET ABM("P")=ABM+1

 +5        SET (DINUM,X)=ABM("X")

           KILL DD,DO

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

 +7        SET DIC("DR")=".02////"_ABM("P")_";.03////"_ABMP("VDT")_";.04////"_ABM("NAR")

           KILL DD,DO

           DO FILE^DICN

 +8        QUIT 

 +9       ;

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

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

           SET DIC(0)="LE"

           KILL DD,DO

 +1        IF +$PIECE($GET(^AAPCRCDS(ABMP("VDFN"),4)),U,13)

               SET ABM("X")=$PIECE(^(4),U,13)

               DO CPTCHK

 +2        GOTO ^ABMDAST4

 +3       ;

CPTCHK     IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),0))

               QUIT 

 +1        SET ABM("CPT")=""

CLOOP      SET ABM("CPT")=$ORDER(^ICPT("I",ABM("X"),ABM("CPT")))

           IF ABM("CPT")=""

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

               SET DA=ABMP("CDFN")

               SET DR=".41////Y"

               DO ^DIE

               KILL DR

               QUIT 

 +1       ;G CLOOP:$P($$CPT^ABMCVAPI(ABM("CPT",ABMP("VDT"))),U,7)!($P($G(^ABMDFEE(ABMP("FEE"),11,ABM("CPT"),0)),U,2)'>0)  ;CSV-c  ;abm*2.6*2 3PMS10003A

 +2       ;CSV-c  ;abm*2.6*2 3PMS10003A

           IF $PIECE($$CPT^ABMCVAPI(ABM("CPT",ABMP("VDT"))),U,7)!($PIECE($$ONE^ABMFEAPI(ABMP("FEE"),11,ABM("CPT"),ABMP("VDT")),U)'>0)

               GOTO CLOOP

 +3        IF $ORDER(^ICPT("I",ABM("X"),ABM("CPT")))'=""

               SET ABMR("DUP")=1

 +4        IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"B",ABM("CPT")))=10

               QUIT 

 +5        SET ABM("P")=1

           IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM("P")))=10

               SET ABM=""

               FOR 

                   SET ABM=$ORDER(^(ABM))

                   IF ABM=""

                       QUIT 

                   SET ABM("P")=ABM+1

 +6        SET X=ABM("CPT")

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

 +8        SET DIC("DR")=".02////"_ABM("P")_";.05////"_ABMP("VDT")_";.06////"_ABM("NAR")

 +9        IF $GET(ABMR("DUP"))=1

               SET DIC("DR")=DIC("DR")_";.08////Y"

           KILL DD,DO

           DO FILE^DICN

 +10       IF ABM("CPT")<59400!ABM("CPT")>59529

               QUIT 

DELIV      IF ABM("CPT")<59500

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

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

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

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

               SET DIC(0)="LE"

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

 +2       ;abm*2.6*2 3PMS10003A

          IF $TEST

               SET (DINUM,X)=720

               SET DIC("DR")=".02////1;.03////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),31,X,$SELECT($GET(ABMP("VDT")):ABMP("VDT"),1:DT)),U)

               KILL DD,DO

               DO FILE^DICN

CESEAR     IF ABM("CPT")>59499

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

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

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

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

               SET DIC(0)="LE"

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

 +2       ;abm*2.6*2 3PMS10003A

          IF $TEST

               SET (DINUM,X)=360

               SET DIC("DR")=".02////1;.03////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),31,X,$SELECT($GET(ABMP("VDT")):ABMP("VDT"),1:DT)),U)

               KILL DD,DO

               DO FILE^DICN

 +3        QUIT