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

ABMDF26.m

Go to the documentation of this file.
  1. ABMDF26 ; IHS/ASDST/DMJ - ADA-99 Dental Export Routine V2000 ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1. ;Original;TMD;09/12/95 8:48 AM
  1. ;
  1. ; IHS/SD/SDR - v2.5 p8 - IM12857/IM13525
  1. ; Created new export mode for ADA-99 v2000 format
  1. ;
  1. ; IHS/SD/SDR - v2.5 p10 - IM20395
  1. ; Split out lines bundled by rev code
  1. ;
  1. K ABM
  1. S U="^"
  1. S ABMP("EXP")=26 ; 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")="" ; Initialize bill IEN
  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)) ; Quit if no dental data
  1. D ENT^ABMDF26A,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")
  1. D FRATE^ABMDE2X1 ; find Flat Rate
  1. S (ABM("C"),ABM,ABM("TCHRG"),ABM("I"),ABM("YTOT"))=0
  1. F S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,ABM)) Q:'ABM D Q:$D(DUOUT)
  1. .S ABM(0)=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,ABM,0))
  1. .D RESET:ABM("I")=0
  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 $P(ABMF(ABM("F")),U,4)=$P($G(^ADEOPS(ABMOPS,88)),U) ; Tooth mnemonic (d)
  1. ..S:ABMF(ABM("F"))["D" $P(ABMF(ABM("F")),U,4)=$P($G(^ADEOPS(ABMOPS,0)),U,4) ; Tooth synonym
  1. .S $P(ABMF(ABM("F")),U,5)=$P(ABM(0),U,6) ; Tooth surf
  1. .S $P(ABMF(ABM("F")),U,9)=$P(^AUTTADA(+ABM(0),0),U,2) ; Svc desc
  1. .S $P(ABMF(ABM("F")),U)=$E($P(ABM(0),U,7),4,5) ; DOS MM
  1. .S $P(ABMF(ABM("F")),U,2)=$E($P(ABM(0),U,7),6,7) ; DOS DD
  1. .S $P(ABMF(ABM("F")),U,3)=($E($P(ABM(0),U,7),1,3)+1700) ; DOS YYYY
  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)
  1. .S $P(ABMF(ABM("F")),U,10)=$S(+$G(ABMP("FLAT")):"",1:ABM("CHRG"))
  1. .S ABM("TCHRG")=ABM("TCHRG")+ABM("CHRG") ; Proc fee
  1. .;
  1. .S ABM("I")=ABM("I")+1 ; Increment line counter
  1. .I ABM("I")=10 D
  1. ..Q:'$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),33,ABM))
  1. ..S ABM("MORE")=1
  1. ..D ^ABMDF26X ; Print form
  1. ..S ABM("I")=0
  1. ;
  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,4)=$E(ABMRX,1,3)
  1. ...S $P(ABMF(ABM("F")),U,5)=$E(ABMRX,4,8)
  1. ...S $P(ABMF(ABM("F")),U,9)=$E(ABMRX,9,99)
  1. ...I ABMRXDT]"" D
  1. ....S $P(ABMF(ABM("F")),U)=$E(ABMRXDT,4,5)
  1. ....S $P(ABMF(ABM("F")),U,2)=$E(ABMRXDT,6,7)
  1. ....S $P(ABMF(ABM("F")),U,3)=$E(ABMRXDT,1,3)+1700
  1. ...S $P(ABMF(ABM("F")),U,8)=ABMRXQTY
  1. ...S $P(ABMF(ABM("F")),U,10)=ABMRXCHG
  1. ...S ABM("TCHRG")=ABM("TCHRG")+ABMRXCHG
  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 ^ABMDF26X ; Print form
  1. ....S ABM("I")=0
  1. ;
  1. D TAIL:ABM("I")
  1. Q
  1. ;
  1. RESET ;
  1. ; Reset line numbers for BODY
  1. F ABM("F")=41:1:48 K ABMF(ABM("F"))
  1. S ABM("F")=40
  1. Q
  1. ;
  1. TAIL ;END OF FORM
  1. I +$G(ABMP("FLAT")) S ABM("TCHRG")=+ABMP("FLAT")
  1. S $P(ABMF(50),U)=ABM("TCHRG") ; Total fee charged on bill
  1. S ABM("YTOT")=ABM("TCHRG")
  1. D YTOT^ABMDFUTL
  1. S (ABM("I"),ABM("TCHRG"))=0
  1. D ^ABMDF26X ; Print form
  1. Q