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

ABMDF3E.m

Go to the documentation of this file. 
  1. ABMDF3E ; IHS/ASDST/DMJ - Set HCFA1500 Print Array - Part 5 ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;TMD;02/26/96 3:55 PM
  1.  ;
  1.  ; IHS/DSD/LSL - 05/20/98 -  NOIS XIA-0398-200180
  1.  ;               Can't get the right dental charges on bill with 00099 
  1.  ;               HCPCS code.  Answer CPT code question in table
  1.  ;               maintenance with CPT code and will print before any
  1.  ;               other
  1.  ; IHS/DSD/LSL - 05/22/98 -  NOIS NCA-0598-180077
  1.  ;               If flat rate, corresponding dx should print all DX
  1.  ;               in order  ie 1,2,3....
  1.  ; IHS/ASDS/DMJ - 05/16/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
  1.  ;     Modified location code to check for satellite first.  If no
  1.  ;     satellite, use parent.
  1.  ; IHS/ASDS/LSL - 11/20/01 - V2.4 Patch 10 - NOIS PAB-1001-90056
  1.  ;     Allow local HCPCS codes to print in 24D
  1.  ; IHS/ASDS/LSL - 11/21/01 - V2.4 Patch 10 - NOIS OLC-1101-190067
  1.  ;     When putting the dental prefix on dental codes, still need
  1.  ;     to see tooth surface and op site.
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
  1.  ; IHS/SD/SDR - v2.5 p8 - task 57
  1.  ;    Added code for RX or MD #
  1.  ; IHS/SD/SDR - v2.5 p9 - IM15591
  1.  ;    Removed extra spaces when printing modifiers
  1.  ; IHS/SD/SDR - v2.5 p9 - IM19691
  1.  ;    Correction to print MD number
  1.  ; IHS/SD/SDR - v2.5 p12 - IM24880
  1.  ;   Made change for number of line items printing per page
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. EMG ;EP for setting Emerg or Special Prog variable
  1.  S (ABM,ABM("EPSDT"))=0
  1.  F  S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM)) Q:'ABM  D
  1.  .S ABM("X")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,0),U)
  1.  .Q:ABM("X")=""
  1.  .I $P(^ABMDCODE(ABM("X"),0),U)["EPSDT"!($P(^(0),U))["FAMILY" S ABM("EPSDT")=1
  1.  S ABM("EMG")=$S($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,5)="Y":1,1:0)
  1.  Q
  1.  ;
  1. PROC ;EP for setting the procedure portion of the ABMF array
  1.  ; input vars: ABMS(ABMS) - the procedure line in internal format
  1.  ;             ABMS("I")  - the current line number
  1.  ;
  1.  ; output vars: ABMF(ABMS("I"))   - procedure line in external format
  1.  ;              ABMF(ABMS("I")-1) - top line for extended descriptions
  1.  ;
  1.  K %DT
  1.  S %DT="T"
  1.  S X=$P(ABMS(ABMS),U,2)                 ; Service date from
  1.  S %DT="T" D ^%DT
  1.  S $P(ABMS(ABMS),U,2)=Y                 ; Service date from in FM Format
  1.  S X=$P(ABMS(ABMS),U,3)                 ; Service date to
  1.  D ^%DT
  1.  S $P(ABMS(ABMS),U,3)=Y                 ; Service date to in FM format
  1.  S ABMR(ABMS,ABMLN)=""
  1.  S ABMR(ABMS,ABMLN)=$P(ABMS(ABMS),U,2,3) ; Form locator 24A
  1.  ; Set Place of service                 ; Form locator 24B 
  1.  ;   21 if visit type is inpatient
  1.  ;   24 if visit type is ambulatory surgery
  1.  ;   23 if clinic 30, emergency medicine
  1.  ;   11 for all other cases
  1.  I $P(ABMS(ABMS),U,10) S $P(ABMR(ABMS,ABMLN),U,3)=$P($G(^ABMDCODE($P(ABMS(ABMS),U,10),0)),U)
  1.  E  D
  1.  .S $P(ABMR(ABMS,ABMLN),U,3)=$S(ABMP("VTYP")=111!($G(ABMP("BTYP"))=111):21,ABMP("VTYP")=831:24,1:11)
  1.  .;   if Place of service set to 11 check to see if pointer exists 
  1.  .;   in Parameter file to Code file and use it
  1.  .I $P(ABMR(ABMS,ABMLN),U,3)=11 D
  1.  ..S ABMPTR=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),"^",6)
  1.  ..S:ABMPTR="" ABMPTR=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",6) Q:'ABMPTR
  1.  ..Q:'$D(^ABMDCODE(ABMPTR,0))
  1.  ..S $P(ABMR(ABMS,ABMLN),U,3)=$P(^ABMDCODE(ABMPTR,0),U)
  1.  .I $P($G(^DIC(40.7,+ABMP("CLN"),0)),"^",2)=30 D
  1.  ..S $P(ABMR(ABMS,ABMLN),U,3)=23
  1.  ; Set Type of service                  ; Form locator 24C
  1.  S $P(ABMR(ABMS,ABMLN),U,4)=$P(ABMS(ABMS),U,7)
  1.  ; Set CPT/HCPCS                        ; Form locator 24D
  1.  I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)]"" D
  1.  .S $P(ABMR(ABMS,ABMLN),U,5)=$P($$CPT^ABMCVAPI($P(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,16),ABMP("VDT")),U,2)  ;CSV-c
  1.  E  I $P($G(ABMS(ABMS)),U,4)]"" D  I 1
  1.  .S $P(ABMR(ABMS,ABMLN),U,5)=$P(ABMS(ABMS),U,4)
  1.  .; If CPT code, and modifier exists, add it
  1.  .S $P(ABMR(ABMS,ABMLN),U,5)=$P(ABMR(ABMS,ABMLN),U,5)_$S($E($P(ABMS(ABMS),U,8))="#":" "_$P($P(ABMS(ABMS),U,8)," "),1:"")
  1.  .S:$G(ABM("EPSDT")) $P(ABMR(ABMS,ABMLN),U,9)="X"  ; Form locator 24H
  1.  .S:$G(ABM("EMG")) $P(ABMR(ABMS,ABMLN),U,10)="X"   ; Form locator 24I
  1.  E  D
  1.  .I $L($P(ABMS(ABMS),U,8))>16 D  Q
  1.  ..S ABMU("LNG")=16
  1.  ..S ABMU("TXT")=$P(ABMS(ABMS),U,8)
  1.  ..S ABMU=4
  1.  ..D LNG^ABMDWRAP
  1.  ..S ABMLND=ABMLN-1,J=0
  1.  ..F  S J=$O(ABMU(J)) Q:+J=0!(+J>3)  D
  1.  ...I J=2 S $P(ABMR(ABMS,ABMLND),U,5)=$G(ABMU(J))
  1.  ...E  S $P(ABMR(ABMS,ABMLND),U)=$G(ABMU(J))
  1.  ...S ABMLND=ABMLND+1
  1.  ..K ABMU
  1.  .S $P(ABMR(ABMS,ABMLN),U,5)=$P(ABMS(ABMS),U,8)
  1.  S ABMCORDX=$P(ABMS(ABMS),U,5)
  1.  I +ABMCORDX>4,$G(ABMP("BDFN")) D
  1.  .S ABMCORDX=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABMCORDX,0)),"^",2)
  1.  I $D(ABMP("FLAT")),$G(ABMP("BDFN")) D
  1.  .N ABMDXCNT,ABMTMP
  1.  .S ABMDXCNT=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,0)),U,4)
  1.  .S:+ABMDXCNT>4 ABMDXCNT=4
  1.  .F ABMTMP=1:1:ABMDXCNT S $P(ABMCORDX,",",ABMTMP)=ABMTMP
  1.  ;Diagnosis code               Form locator 24E
  1.  S $P(ABMR(ABMS,ABMLN),U,6)=ABMCORDX
  1.  ;Charges                      Form locator 24F
  1.  S $P(ABMR(ABMS,ABMLN),U,7)=$P(ABMS(ABMS),U)
  1.  ;Days or units                Form locator 24G
  1.  S $P(ABMR(ABMS,ABMLN),U,8)=$P(ABMS(ABMS),U,6)
  1.  ;Reserved for local use       Form locator 24K
  1.  I $P(ABMS(ABMS),"^",9)'="" D
  1.  .S ABMLOCAL=$P(ABMS(ABMS),"^",9)
  1.  .I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",15)="RX" D
  1.  ..S $P(ABMR(ABMS,ABMLN),U,12)=$P(ABMLOCAL,";;")  ;Prescription#
  1.  .I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",15)="MD" D
  1.  ..S $P(ABMR(ABMS,ABMLN),U,12)=ABMLOCAL
  1.  .K ABMLOCAL
  1.  K ABMS(ABMS),ABMPTR,ABMCORDX
  1.  Q