- 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