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

ABMDF35E.m

Go to the documentation of this file.
  1. ABMDF35E ; IHS/SD/SDR - Set HCFA1500 (02/12) Print Array - Part 5 ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;**13,21,22**;NOV 12, 2009;Build 418
  1. ;IHS/SD/SDR - 2.6*21 - HEAT223194 - Fixed EPSDT field so it will print either the second character from the referral
  1. ; or an 'U' for no referral.
  1. ;IHS/SD/SDR 2.6*22 HEAT335246 Added code to print the appropriate CPT based on if the NDC prompt is answered or not.
  1. ;
  1. ; *********************************************************************
  1. ;
  1. EMG ;EP for setting Emerg or Special Prog variable
  1. ;S (ABM,ABM("EPSDT"))=0 ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. S ABM=0 ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. S ABM("EPSDT")="" ;abm*2.6*21 IHS/SD/SDR HEAT223194
  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 ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. .I ($P(^ABMDCODE(ABM("X"),0),U,3)["EPSDT") D ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. ..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,0)),U,2)="N" S ABM("EPSDT")="U" Q ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. ..S ABM("EPSDT")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,1,0)) ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. ..S ABM("EPSDT")=$E($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABM,1,ABM("EPSDT"),0)),U),2) ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. .I ($P(^(0),U,3)["FAMILY") S ABM("EPSDT")="X" ;abm*2.6*21 IHS/SD/SDR HEAT223194
  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 ABMFDT=$P(ABMS(ABMS),U,2) ;Service date from
  1. S X=$P($P(ABMS(ABMS),U,2),"@") ;Service date from
  1. D ^%DT
  1. S $P(ABMS(ABMS),U,2)=Y ; Service date from in FM Format
  1. S ABMTDT=$P(ABMS(ABMS),U,3) ;Service date to
  1. S X=$P($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. ;check if time on charge (anes); if so, add as line 1
  1. I ABMFDT["@" D
  1. .S $P(ABMR(ABMS,ABMLN-1),U)="7Begin "_$TR($P(ABMFDT,"@",2),":")
  1. .S $P(ABMR(ABMS,ABMLN-1),U)=$P(ABMR(ABMS,ABMLN-1),U)_" End "_$TR($P(ABMTDT,"@",2),":")
  1. ;
  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 is emergency medicine (code 30)
  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("BTYP")=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. ;
  1. ; Set CPT/HCPCS ; Form locator 24D
  1. I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y" S $P(ABMR(ABMS,ABMLN),U,5)=$P(ABMS(ABMS),U,4) ;abm*2.6*22 IHS/SD/SDR HEAT335246
  1. I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)]"" D
  1. .I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y" Q ;don't write default CPT if they want NDC to print ;abm*2.6*22 IHS/SD/SDR HEAT335246
  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 ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. .S:$G(ABM("EPSDT"))'="" $P(ABMR(ABMS,ABMLN),U,9)=$G(ABM("EPSDT")) ; Form locator 24H ;abm*2.6*21 IHS/SD/SDR HEAT223194
  1. .S:$G(ABM("EMG")) $P(ABMR(ABMS,ABMLN),U,4)="X" ; Form locator 24C
  1. E D
  1. .I $P($G(^AUTNINS(ABMP("INS"),0)),U)["PHC MEDICAID" S $P(ABMS(ABMS),U,8)=$TR($P(ABMS(ABMS),U,8),"-")
  1. S:$P(ABMR(ABMS,ABMLN),U,5)["NO CODE SELECTED" $P(ABMR(ABMS,ABMLN),U,5)=""
  1. I $L($P(ABMS(ABMS),U,8))>16,($E($P(ABMS(ABMS),U,8),1,2)="N4") D
  1. .S ABMU("LNG")=60
  1. .S ABMU("TXT")=$P(ABMS(ABMS),U,8)
  1. .S ABMU=3
  1. .D LNG^ABMDWRAP
  1. .S ABMLND=ABMLN-1,J=0
  1. .F S J=$O(ABMU(J)) Q:+J=0!(+J>2) D
  1. ..S $P(ABMR(ABMS,ABMLND),U)=$G(ABMU(J))
  1. ..S ABMLND=ABMLND+1
  1. .K ABMU
  1. E S:($E($P(ABMS(ABMS),U,8),1,2)="N4") $P(ABMR(ABMS,ABMLN),U,5)=$P(ABMS(ABMS),U,8)
  1. ; Diagnosis code Form locator 24E
  1. S ABMCORDX=$P(ABMS(ABMS),U,5)
  1. S ABMCORDX=$P(ABMCORDX,",",1,4)
  1. I +$G(ABMCORDX)=0 S ABMCORDX=1 ;for flat rate; doesn't set corr. dx
  1. F ABMTMP=1:1:$L(ABMCORDX,",") D
  1. .S $P(ABMCORDX,",",ABMTMP)=$P("A^B^C^D^E^F^G^H^I^J^K^L^","^",$P(ABMCORDX,",",ABMTMP))
  1. S $P(ABMR(ABMS,ABMLN),U,6)=$TR(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)
  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)="MD" D
  1. ..S $P(ABMR(ABMS,ABMLN-1),U,3)=ABMLOCAL
  1. .K ABMLOCAL
  1. I $G(ABMP("EXP"))=35 D
  1. .S:+$G(ABMDUZ2)=0 ABMDUZ2=DUZ(2)
  1. .S ABMPQ=$S(ABMP("ITYPE")="R":"1C"_" ",ABMP("ITYPE")="D":"1D"_" ",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B"_" ")
  1. I ($P(ABMS(ABMS),U,11)&($G(ABMP("NPIS"))'="")&(ABMP("NPIS")'="N")) D
  1. .S $P(ABMR(ABMS,ABMLN-1),U,2)=ABMPQ
  1. .S $P(ABMR(ABMS,ABMLN-1),U,3)=$P(ABMS(ABMS),U,9)
  1. I $G(ABMP("ITYPE"))="R"&($G(ABMP("BTYP"))="831") S $P(ABMR(ABMS,ABMLN-1),U,3)=""
  1. S:$P(ABMS(ABMS),U,11) $P(ABMR(ABMS,ABMLN),U,11)=$P(ABMS(ABMS),U,11) ;Form Locator 24K (2)
  1. K ABMS(ABMS),ABMPTR,ABMCORDX
  1. Q