Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDAST3

ABMDAST3.m

Go to the documentation of this file.
  1. ABMDAST3 ; IHS/ASDST/DMJ - ACC VISIT STUFF - PART 4 ;
  1. ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009
  1. ;
  1. ; IHS/SD/SDR - v2.6 CSV
  1. ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to use ABMFEAPI
  1. ;
  1. S ABM("NAR")=""
  1. PRC I +$P($G(^AAPCRCDS(ABMP("VDFN"),4)),U,13) S ABM("X")=$P(^(4),U,13) D PRCCHK
  1. G CPT
  1. ;
  1. PRCCHK Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0))
  1. S ABM("P")=1,X=$P($$ICDOP^ABMCVAPI(ABM("X"),ABMP("VDT")),U,5) ;CSV-c
  1. S (DIC,DLAYGO)=9999999.27,DIC(0)="XL" D ^DIC Q:Y<0 S ABM("NAR")=+Y
  1. S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",19,",DIC(0)="LE"
  1. 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
  1. S (DINUM,X)=ABM("X") K DD,DO
  1. S DIC("P")=$P(^DD(9002274.3,19,0),U,2)
  1. S DIC("DR")=".02////"_ABM("P")_";.03////"_ABMP("VDT")_";.04////"_ABM("NAR") K DD,DO D FILE^DICN
  1. Q
  1. ;
  1. CPT S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",21,",DIC(0)="LE" K DD,DO
  1. I +$P($G(^AAPCRCDS(ABMP("VDFN"),4)),U,13) S ABM("X")=$P(^(4),U,13) D CPTCHK
  1. G ^ABMDAST4
  1. ;
  1. CPTCHK Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,ABM("X"),0))
  1. S ABM("CPT")=""
  1. 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
  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
  1. 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
  1. S:$O(^ICPT("I",ABM("X"),ABM("CPT")))'="" ABMR("DUP")=1
  1. Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"B",ABM("CPT")))=10
  1. 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
  1. S X=ABM("CPT")
  1. S DIC("P")=$P(^DD(9002274.3,21,0),U,2)
  1. S DIC("DR")=".02////"_ABM("P")_";.05////"_ABMP("VDT")_";.06////"_ABM("NAR")
  1. S:$G(ABMR("DUP"))=1 DIC("DR")=DIC("DR")_";.08////Y" K DD,DO D FILE^DICN
  1. I ABM("CPT")<59400!ABM("CPT")>59529 Q
  1. 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"
  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
  1. 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
  1. 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"
  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
  1. 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
  1. Q