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

ABMDF4.m

Go to the documentation of this file. 
  1. ABMDF4 ; IHS/ASDST/DMJ - ADA-90 Dental Export Routine ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;TMD;08/15/96 1:11 PM
  1.  ;
  1.  ;  IHS/DSD/DMJ - NOIS XFA-0698-200102
  1.  ;      Meds showing up on split bill for ADA & HCFA.  Modified to
  1.  ;      show meds on HCFA only also add code so claim generator will
  1.  ;      not bomb if auto approve is turned on and Y2K fix to print 4
  1.  ;      digit year in 3 birthdate fields.
  1.  ; IHS/DSD/DMJ - 5/10/1999 - NOIS XAA-0599-200017 Patch 1
  1.  ;           Itemized bills printing flat rate in batches at line BODY+4
  1.  ; IHS/ASDS/LSL - 05/01/01 - V2.4 Patch 9 - NOIS HQW-0900-100053
  1.  ;     Modified to allow use of dental prefix code on the ADA-90 form
  1.  ;     as well.
  1.  ;
  1.  ; IHS/SD/EFG - V2.5 P8 - IM16385
  1.  ;    Check for dental and misc services
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20395
  1.  ;   Split out lines bundled by rev code
  1.  ; IHS/SD/SDR - v2.5 p12 - IM24844
  1.  ;   Fix for <UNDEF>BODY+78^ABMDF4
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1.  K ABM
  1.  S U="^"
  1.  S ABMP("EXP")=4                        ; Export Mode
  1.  D TXST^ABMDFUTL                        ; Create entry in 3P TX STATUS
  1.  S ABMY("N")=0                          ; Initialize active insurer
  1.  ; Print a form for every bill within an active insurer
  1.  F  S ABMY("N")=$O(ABMY(ABMY("N"))) Q:'ABMY("N")  D
  1.  .S ABMP("BDFN")=""
  1.  .F  S ABMP("BDFN")=$O(ABMY(ABMY("N"),ABMP("BDFN"))) Q:'ABMP("BDFN")  D
  1.  ..D ENT
  1.  ..S DIE="^ABMDBILL(DUZ(2),"
  1.  ..S DA=ABMP("BDFN")
  1.  ..S DR=".04////B;.16////A;.17////"_ABMP("XMIT")
  1.  ..D ^ABMDDIE
  1.  ..Q:$D(ABM("DIE-FAIL"))
  1.  ;
  1.  D TXUPDT^ABMDFUTL                           ; Update 3P TX STATUS
  1.  ;
  1. XIT ;
  1.  K ABM,ABMF,ABMV
  1.  Q
  1.  ;
  1. ENT ;EP for getting data and printing form
  1.  K ABMF
  1.  Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))     ; Quit if no bill data
  1.  Q:'$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,0))&('$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),43,0)))  ;Quit if no dental or misc data
  1.  D ENT^ABMDF4A,BODY
  1.  Q
  1.  ;
  1. BODY ;
  1.  ; For each dental entry in the bill file, find and print data
  1.  S ABMX("INS")=ABMP("INS")              ; IEN to INSURER
  1.  K ABMP("FLAT") D FRATE^ABMDE2X1                       ; find Flat Rate
  1.  S (ABM("C"),ABM,ABM("TCHRG"),ABM("I"),ABM("YTOT"))=0
  1.  ; BOX 30 
  1.  F  S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,ABM)) Q:'ABM  S ABM(0)=^(ABM,0) D  Q:$D(DUOUT)
  1.  .D RESET:ABM("I")=0
  1.  .;
  1.  .S ABM("F")=ABM("F")+1                ; Increment line counter
  1.  .I $P(ABM(0),U,5) D
  1.  ..S ABMOPS=$P(ABM(0),U,5)            ; IEN to DENTAL OPERATIVE SITE
  1.  ..S ABMF(ABM("F"))=$P($G(^ADEOPS(ABMOPS,88)),U)  ; Tooth Mnemonic
  1.  ..S:ABMF(ABM("F"))["D" ABMF(ABM("F"))=$P($G(^ADEOPS(ABMOPS,0)),U,4)  ; Tooth synonym
  1.  .S $P(ABMF(ABM("F")),U,2)=$P(ABM(0),U,6)            ; Tooth Surface
  1.  .S $P(ABMF(ABM("F")),U,3)=$P(^AUTTADA(+ABM(0),0),U,2)  ; Service Desc
  1.  .S $P(ABMF(ABM("F")),U,4)=$E($P(ABM(0),U,7),4,5)    ; Date of serv. MM
  1.  .S $P(ABMF(ABM("F")),U,5)=$E($P(ABM(0),U,7),6,7)    ; Date of serv. DD
  1.  .S $P(ABMF(ABM("F")),U,6)=$E($P(ABM(0),U,7),2,3)    ; Date of serv. YY
  1.  .S $P(ABMF(ABM("F")),U,7)=$P(^AUTTADA(+ABM(0),0),U) ; Procedure #
  1.  .S ABMDENP=$P($G(^ABMDREC(ABMP("INS"),0)),U,2)      ; Dent remap
  1.  .S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,11)
  1.  .S:ABMDENP="" ABMDENP=$P($G(^ABMDPARM(DUZ(2),1,3)),U,11)
  1.  .S:ABMDENP]"" $P(ABMF(ABM("F")),U,7)=ABMDENP_$P(ABMF(ABM("F")),U,7)
  1.  .S ABM("CHRG")=+$P(ABM(0),U,8)*(+$P(ABM(0),U,9))
  1.  .S $P(ABMF(ABM("F")),U,8)=$S(+$G(ABMP("FLAT")):"",1:ABM("CHRG"))
  1.  .S ABM("TCHRG")=ABM("TCHRG")+ABM("CHRG")            ; Fee
  1.  .;
  1.  .S ABM("I")=ABM("I")+1                ; Increment line counter
  1.  .I ABM("I")=14 D
  1.  ..Q:'$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,ABM))
  1.  ..S ABM("MORE")=1
  1.  ..D ^ABMDF4X                         ; Print form
  1.  ..S ABM("I")=0
  1.  ;
  1.  N ABMRV
  1.  D 43^ABMERGR2  ;obtain misc services data in ABMRV array
  1.  S ABMRCD=-1
  1.  F  S ABMRCD=$O(ABMRV(ABMRCD)) Q:ABMRCD=""  D
  1.  .S ABMED=""
  1.  .F  S ABMED=$O(ABMRV(ABMRCD,ABMED)) Q:ABMED=""  D  Q:$D(DUOUT)
  1.  ..S ABMCNTR=0
  1.  ..F  S ABMCNTR=$O(ABMRV(ABMRCD,ABMED,ABMCNTR)) Q:ABMCNTR=""  D
  1.  ...D RESET:ABM("I")=0
  1.  ...S ABM("F")=ABM("F")+1
  1.  ...S ABMMS=$P($$CPT^ABMCVAPI($O(^ICPT("B",ABMED,"")),ABMP("VDT")),U,3)  ;CPT name  ;CSV-c
  1.  ...S ABMMSDT=$P(ABMRV(ABMRCD,ABMED,ABMCNTR),U,10)  ;date
  1.  ...S ABMMSQTY=$P(ABMRV(ABMRCD,ABMED,ABMCNTR),U,5)  ;quantity
  1.  ...S ABMMSCHG=$P(ABMRV(ABMRCD,ABMED,ABMCNTR),U,6)  ;charge
  1.  ...I ABMMSDT]"" D
  1.  ....S $P(ABMF(ABM("F")),U,3)=ABMMS
  1.  ....S $P(ABMF(ABM("F")),U,4)=$E(ABMMSDT,4,5)
  1.  ....S $P(ABMF(ABM("F")),U,5)=$E(ABMMSDT,6,7)
  1.  ....S $P(ABMF(ABM("F")),U,6)=$E(ABMMSDT,2,3)
  1.  ...S $P(ABMF(ABM("F")),U,7)=$P($G(ABMRV(ABMRCD,ABMED)),U,2)
  1.  ...S $P(ABMF(ABM("F")),U,8)=ABMMSCHG
  1.  ...S ABM("TCHRG")=ABM("TCHRG")+ABMMSCHG
  1.  ...S ABM("I")=ABM("I")+1
  1.  ...I ABM("I")=10 D
  1.  ....Q:($O(ABMRV(ABMRCD,ABMED))=""&($O(ABMRV(ABMRCD))=""))
  1.  ....S ABM("MORE")=1
  1.  ....D ^ABMDF4X  ;print form
  1.  ....S ABM("I")=0
  1.  ; Put RX data on dental form
  1.  N ABMRV
  1.  D 23^ABMERGR2    ; Obtain RX data in ABMRV array
  1.  S ABMRCD=-1
  1.  F  S ABMRCD=$O(ABMRV(ABMRCD)) Q:ABMRCD=""  D
  1.  .S ABMED=0
  1.  .F  S ABMED=$O(ABMRV(ABMRCD,ABMED)) Q:'+ABMED  D  Q:$D(DUOUT)
  1.  ..S ABMCNTR=0
  1.  ..F  S ABMCNTR=$O(ABMRV(ABMRCD,ABMED,ABMCNTR)) Q:ABMCNTR=""  D
  1.  ...D RESET:ABM("I")=0
  1.  ...S ABM("F")=ABM("F")+1
  1.  ...S ABMRX=$P(ABMRV(ABMRCD,ABMED,ABMCNTR),U,9)     ; NDC# name
  1.  ...S ABMRXDT=$P(ABMRV(ABMRCD,ABMED,ABMCNTR),U,10)  ; date/time
  1.  ...S ABMRXQTY=$P(ABMRV(ABMRCD,ABMED,ABMCNTR),U,5)  ; Quantity
  1.  ...S ABMRXCHG=$P(ABMRV(ABMRCD,ABMED,ABMCNTR),U,6)  ; Charge
  1.  ...S $P(ABMF(ABM("F")),U)=$E(ABMRX,1,3)
  1.  ...S $P(ABMF(ABM("F")),U,2)=$E(ABMRX,4,8)
  1.  ...S $P(ABMF(ABM("F")),U,3)=$E(ABMRX,9,99)
  1.  ...I ABMRXDT]"" D
  1.  ....S $P(ABMF(ABM("F")),U,4)=$E(ABMRXDT,4,5)
  1.  ....S $P(ABMF(ABM("F")),U,5)=$E(ABMRXDT,6,7)
  1.  ....S $P(ABMF(ABM("F")),U,6)=$E(ABMRXDT,2,3)
  1.  ...S $P(ABMF(ABM("F")),U,7)="QTY "_ABMRXQTY
  1.  ...S $P(ABMF(ABM("F")),U,8)=ABMRXCHG
  1.  ...S ABM("TCHRG")=ABM("TCHRG")+ABMRXCHG
  1.  ...S ABM("I")=ABM("I")+1
  1.  ...I ABM("I")=14 D
  1.  ....Q:($O(ABMRV(ABMRCD,ABMED))=""&($O(ABMRV(ABMRCD))=""))
  1.  ....S ABM("MORE")=1
  1.  ....D ^ABMDF4X                         ; Print form
  1.  ....S ABM("I")=0
  1.  ;
  1.  D TAIL:ABM("I")
  1.  Q
  1.  ;
  1. RESET ; Reset line numbers for BODY
  1.  F ABM("F")=35:1:48 K ABMF(ABM("F"))
  1.  S ABM("F")=34
  1.  Q
  1.  ;
  1. TAIL ;END OF FORM
  1.  I +$G(ABMP("FLAT")) S ABM("TCHRG")=+ABMP("FLAT")
  1.  S $P(ABMF(57),U,4)=ABM("TCHRG")        ; Total fee charged
  1.  S ABM("YTOT")=ABM("TCHRG")
  1.  D YTOT^ABMDFUTL
  1.  S (ABM("I"),ABM("TCHRG"))=0
  1.  D ^ABMDF4X                             ; Print form
  1.  Q