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

ABMDUTL.m

Go to the documentation of this file. 
  1. ABMDUTL ; IHS/SD/SDR - UTILITY FOR 3P BILLING PACKAGE ;     
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,15,21,27**;NOV 12, 2009;Build 486
  1.  ;IHS/SD/SDR v2.5 p9 IM12408 - Added code for inactive CPTs to check visit date
  1.  ;IHS/SD/SDR v2.5 p9 IM16660 - Coded for 4-digit revenue codes
  1.  ;IHS/SD/SDR v2.5 p10 IM20454 - Fix xref on .03 field
  1.  ;IHS/SD/SDR v2.5 p11 IM23431 - Fix lookup of HCPCS codes
  1.  ;
  1.  ;IHS/SD/SDR 2.6 CSV
  1.  ;IHS/SD/SDR 2.6*6 5010 added new call BDT for complete date, includ. seconds
  1.  ;IHS/SD/SDR 2.6*15 HEAT188548 added code to make length of time 6 characters
  1.  ;IHS/SD/SDR 2.6*21 HEAT122118 added code to look in bill file for new claim number as well.
  1.  ;IHS/SD/SDR 2.6*21 HEAT139641 Changed 3P Insurer references from DUZ(2) to ABMP("LDFN")
  1.  ;IHS/SD/SDR 2.6*27 CR8894 NEW ABMZCPT array so it won't hang around and create <STORE> error if user types ?? at CPT prompt
  1.  ;  and then just scrolls the list of codes
  1.  ;
  1. SDT(X) ;EP - Y is set to the printable date ##/##/#### from X (fileman date)
  1.  N Y
  1.  S Y=$S(+X>0:$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700),1:"")
  1.  Q Y
  1. POSDT(X) ;EP - Y is set to the printable date ## ## #### from X (fileman date)
  1.  N Y
  1.  S Y=$$SDT(X)
  1.  S Y=$TR(Y,"/"," ")
  1.  Q Y
  1.  ;
  1. HDT(X) ;EP - Y is set to the printable date ##-##-#### from X (fileman date)
  1.  N Y
  1.  S Y=$S(+X>0:$E(X,4,5)_"-"_$E(X,6,7)_"-"_($E(X,1,3)+1700),1:"")
  1.  Q Y
  1.  ;
  1. CDT(X) ;EP - Y= date/time ##/##/####@##:## from X (fm date) for display in claim editor
  1.  N Y
  1.  I '+X S Y="" Q Y
  1.  S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
  1.  I '$P(X,".",2) Q Y
  1.  S ABMTIME=$P(X,".",2)
  1.  S ABMTIME=ABMTIME_"00"
  1.  S Y=Y_"@"_$E(ABMTIME,1,2)_":"_$E(ABMTIME,3,4)
  1.  Q Y
  1.  ;start new code abm*2.6*6 5010
  1. BDT(X) ;EP - Y= date/time ##/##/####@##:##:## from X (fm date) for display in claim editor
  1.  N Y
  1.  N ABMTEST,A  ;abm*2.6*15 HEAT188548
  1.  I '+X S Y="" Q Y
  1.  S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
  1.  I '$P(X,".",2) Q Y
  1.  S ABMTIME=$P(X,".",2)
  1.  ;S ABMTIME=ABMTIME_"00"  ;abm*2.6*15 HEAT188548
  1.  ;start new abm*2.6*15 HEAT188548
  1.  I $L(ABMTIME<6) D
  1.  .S ABMTEST=$L(ABMTIME)
  1.  .F A=1:1:(6-ABMTEST) S ABMTIME=ABMTIME_"0"
  1.  ;end new HEAT188548
  1.  I $L(ABMTIME<6) D
  1.  S Y=Y_"@"_$E(ABMTIME,1,2)_":"_$E(ABMTIME,3,4)_":"_$E(ABMTIME,5,6)
  1.  Q Y
  1.  ;end new code 5010
  1. MDT(X) ;EP - printable date and time in menu header format
  1.  N Y
  1.  S ABM("DATE")=+$E(X,6,7)_"-"_$P($T(MTHS+1),";;",+$E(X,4,5)+1)_"-"_($E(X,1,3)+1700)
  1.  S ABM("TIME")=$P(X,".",2) I ABM("TIME")'="" D
  1.  .S ABM("TIME")="."_ABM("TIME")
  1.  .S ABM("TIME")=$E(X,8,15)+.0000001
  1.  .S ABM("AMPM")=$S(ABM("TIME")>.1159999:"PM",1:"AM")
  1.  .I ABM("TIME")>.1259999 S ABM("TIME")=ABM("TIME")-.12
  1.  .S ABM("TIME")=+$E(ABM("TIME"),2,3)_":"_$E(ABM("TIME"),4,5)_" "_ABM("AMPM")
  1.  S X=ABM("DATE")_" "_ABM("TIME")
  1.  K ABM("DATE"),ABM("TIME"),ABM("AMPM")
  1.  Q X
  1. Y2KDT(X) ;EP - date from fileman to Y2K format Y=MMDDCCYY
  1.  N Y
  1.  I X="" Q X
  1.  S Y=$E(X,4,7)_($E(X,1,3)+1700)
  1.  Q Y
  1. Y2KD2(X) ;EP - date from fileman to Y2K format Y=CCYYMMDD
  1.  N Y
  1.  I X="" Q X
  1.  S Y=($E(X,1,3)+1700)_$E(X,4,7)
  1.  Q Y
  1. MDY(X) ;EP - date from fileman to MMDDYY
  1.  N Y
  1.  I X="" Q X
  1.  S Y=$E(X,4,7)_$E(X,2,3)
  1.  Q Y
  1. SDTO(X) ;EP - date from fileman to MM/DD/YY
  1.  N Y
  1.  I X="" Q X
  1.  S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1.  Q Y
  1. HDTO(X) ;EP - old HDT entry point, date from fileman to MM-DD-YY
  1.  N Y
  1.  I X="" Q X
  1.  S Y=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
  1.  Q Y
  1. MTHS ;MONTHS
  1.  ;;JAN;;FEB;;MAR;;APR;;MAY;;JUN;;JUL;;AUG;;SEP;;OCT;;NOV;;DEC
  1. HRN(X) ;EP - Y is set to the printable HRN
  1.  ;     for patient ABMP("PDFN") at location ABMP("LDFN")
  1.  N Y
  1.  S Y=$S('$G(ABMP("PDFN")):"[no PAT]",'$G(ABMP("LDFN")):"[no LOC]",$D(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)):"[HRN:"_$P(^(0),U,2)_"]",1:"[no HRN]")
  1.  Q Y
  1.  ;
  1. CSZ(X) ;EP - Y is set to the printable City, State ZIP CODE
  1.  ; X incoming variable must = CITY^ST^ZIP
  1.  N Y
  1.  S Y=$S($G(X)="":"no address",$P(X,U)="":"no city",'$P(X,U,2):"no state",$P($G(^DIC(5,$P(X,U,2),0)),U,2)="":"invalid state",'$P(X,U,3):"no zip",1:$P(X,U)_", "_$P(^(0),U,2)_"  "_$P(X,U,3))
  1.  Q Y
  1. TM(X,Y) ;EP - FIGURE TOTAL MINUTES GIVEN FM DATE/TIMES IN X AND Y
  1.  I X="" Q X
  1.  I Y="" S X="" Q X
  1.  D H^%DTC S ABM(1,1)=%H,ABM(1,2)=%T
  1.  S X=Y D H^%DTC S ABM(2,1)=%H,ABM(2,2)=%T
  1.  S ABM("D")=ABM(2,1)-ABM(1,1)*24*60*60
  1.  S ABM("T")=ABM(2,2)-ABM(1,2)
  1.  S ABM("TS")=ABM("D")+ABM("T")
  1.  S X=ABM("TS")\60
  1.  Q X
  1. PAT(X) ;EP - DISPLAY PATIENT HEADER WITH IDENTIFIERS - X=DFN
  1.  Q:'$D(^DPT(+X,0))
  1.  S $P(ABM("="),"=",80)=""
  1.  W $$EN^ABMVDF("IOF")
  1.  W !,$$EN^ABMVDF("RVN"),"PATIENT:",$$EN^ABMVDF("RVF"),"  "
  1.  S ABM("P0")=^DPT(X,0)
  1.  W $P(ABM("P0"),U),"     ",$P(ABM("P0"),"^",2)
  1.  S ABM("DOB")=$P(ABM("P0"),"^",3) W "  ",$E(ABM("DOB"),4,5),"/",$E(ABM("DOB"),6,7),"/",($E(ABM("DOB"),1,3)+1700)
  1.  S ABM("SSN")=$P(ABM("P0"),"^",9)
  1.  W "  ",$E(ABM("SSN"),1,3),"-",$E(ABM("SSN"),4,5),"-",$E(ABM("SSN"),6,9)
  1.  W "  ","HRN: ",$P($G(^AUPNPAT(X,41,DUZ(2),0)),"^",2)
  1.  W !,ABM("=")
  1.  Q
  1. FLAT(X,Y,Z)          ;EP - DETERMINE FLAT RATE
  1.  ;X=INSURER, Y=VISIT TYPE, Z=DATE
  1.  S N=Z+.5
  1.  ;S ABMDT=$O(^ABMNINS(DUZ(2),X,1,Y,11,"B",N),-1)  ;abm*2.6*21 IHS/SD/AML HEAT139641
  1.  S ABMDT=$O(^ABMNINS(ABMP("LDFN"),X,1,Y,11,"B",N),-1)  ;abm*2.6*21 IHS/SD/AML HEAT139641
  1.  I 'ABMDT S X=0 K ABMDT Q X
  1.  ;start old abm*2.6*21 IHS/SD/AML HEAT139641
  1.  ;S ABMDA=$O(^ABMNINS(DUZ(2),X,1,Y,11,"B",ABMDT,0))
  1.  ;S ABMZERO=$G(^ABMNINS(DUZ(2),X,1,Y,11,ABMDA,0))
  1.  ;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
  1.  S ABMDA=$O(^ABMNINS(ABMP("LDFN"),X,1,Y,11,"B",ABMDT,0))
  1.  S ABMZERO=$G(^ABMNINS(ABMP("LDFN"),X,1,Y,11,ABMDA,0))
  1.  ;end new abm*2.6*21 IHS/SD/AML HEAT139641
  1.  S X=$P(ABMZERO,"^",2)
  1.  I $P(ABMZERO,"^",3),$P(ABMZERO,"^",3)<Z S X=0
  1.  K ABMZERO,ABMDT,ABMDA
  1.  Q X
  1. NXNM(X) ;EP - GET NEXT CLAIM NUMBER
  1.  I '$D(^ABMDCLM(0)) D
  1.  .S ^ABMDCLM(0)=0
  1.  .N I S I=0 F  S I=$O(^ABMDCLM(I)) Q:'I  D
  1.  ..Q:$P(^ABMDCLM(I,0),"^",3)'>^ABMDCLM(0)
  1.  ..S ^ABMDCLM(0)=$P(^ABMDCLM(I,0),"^",3)
  1.  L +^ABMDCLM(0):30 I '$T S X="" Q X
  1.  ;start old abm*2.6*21 IHS/SD/SDR HEAT122118
  1.  ;F  D  Q:'$D(^ABMDCLM(DUZ(2),X))
  1.  ;.S X=^ABMDCLM(0)+1
  1.  ;.S ^ABMDCLM(0)=X
  1.  ;end old start new abm*2.6*21 IHS/SD/SDR HEAT122118
  1.  F  D  Q:'$D(^ABMDCLM(DUZ(2),X))&(+$O(^ABMDBILL(DUZ(2),"B",X_"@"))'[X)
  1.  .S X=^ABMDCLM(0)+1
  1.  .S ^ABMDCLM(0)=X
  1.  ;end new abm*2.6*21 IHS/SD/SDR HEAT122118
  1.  L -^ABMDCLM(0)
  1.  Q X
  1. EOP(X) ;EP - end of page
  1.  ;X=0, 1, or 2
  1.  Q:$G(IOT)'["TRM"
  1.  Q:$E($G(IOST))'="C"
  1.  Q:$D(IO("S"))
  1.  Q:$D(ZTQUEUED)
  1.  F  W ! Q:$Y+4>IOSL
  1.  Q:X=2
  1.  S DIR(0)="E"
  1.  S:X=1 DIR("A")="Enter RETURN to continue"
  1.  D ^DIR
  1.  K DIR
  1.  Q
  1. SETI03 ;EP Set logic for ACTIVE x-ref of .03 field of 13 multiple of claim
  1.  Q:X'="I"
  1.  S $P(^ABMDCLM(DUZ(2),DA(1),0),U,8)=$S($P($G(^ABMDCLM(DUZ(2),DA(1),13,DA,0)),U,11)'="":$P($G(^ABMDCLM(DUZ(2),DA(1),13,DA,0)),U,11),1:+^ABMDCLM(DUZ(2),DA(1),13,DA,0))
  1.  Q
  1. KILLI03 ;EP Kill logic for ACTIVE x-ref of ,03 field or 13 multiple of claim
  1.  Q
  1. UPRV(X,Y)          ;EP unbillable providers
  1.  ;x=claim ien
  1.  ;y=coverage ien
  1.  I '$G(X) Q 0
  1.  I '$G(Y) Q 0
  1.  I '$O(^ABMDCLM(DUZ(2),X,41,0)) Q 0
  1.  S Z=1
  1.  N I,ABMPRV,ABMCLAS
  1.  S I=0
  1.  F  S I=$O(^ABMDCLM(DUZ(2),X,41,I)) Q:'I  D
  1.  .S ABMPRV=$P(^ABMDCLM(DUZ(2),X,41,I,0),U)
  1.  .S ABMCLAS=$P($G(^VA(200,+ABMPRV,"PS")),"^",5)
  1.  .Q:$P($G(^AUTTPIC(+Y,15,+ABMCLAS,0)),"^",2)="U"
  1.  .S Z=0
  1.  Q Z
  1. CHKCPT(Y) ; check CPT for valid date, inactive flag
  1.  NEW A,I,D
  1.  NEW ABMY
  1.  NEW X  ;CSV-c
  1.  NEW ABMZCPT  ;this variable was hanging around  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  S ABMY=$S(+$G(Y)=0:$O(^ICPT("B",Y,0)),1:Y)
  1.  Q:+$G(ABMY)=0 0
  1.  S:'$G(ABMP("VDT")) ABMP("VDT")=DT  ;default for dt
  1.  ;I $P($$CPT^ABMCVAPI(ABMY,ABMP("VDT")),U,7)=0 Q 0  ;CSV-c  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  ;start new abm*2.6*27 IHS/SD/SDR CR8894
  1.  S X=$$CPT^ABMCVAPI(ABMY,ABMP("VDT"))
  1.  I (+$G(X)'=0) D  Q A
  1.  .I $P(X,U,7)'=0 S A=1 Q
  1.  .E  S A=0
  1.  ;end new abm*2.6*27 IHS/SD/SDR CR8894
  1.  S X=$$IHSCPT^ABMCVAPI(ABMY,ABMP("VDT"))  ;CSV-c
  1.  S A=$P(X,U,7),I=$P(X,U,8)  ;CSV-c
  1.  ;A is date added, I is date inactivated/deleted
  1.  I $G(ABMP("VDT")),(I]""),(ABMP("VDT")>I) Q 0  ;have date, date after inactive date
  1.  I '$G(ABMP("VDT")),($P($$CPT^ABMCVAPI(ABMY,ABMP("VDT")),U,7)) Q 0  ;CSV-c
  1.  Q 1
  1. GETREV(X) ;PEP - get rev code and format for claim editor display
  1.  S ABMRVCD="****"
  1.  I X="" Q ABMRVCD
  1.  I $D(^AUTTREVN(X,0)) D  Q ABMRVCD
  1.  .S ABMRVCD=$S($L($P($G(^AUTTREVN(X,0)),U))=3:"0"_$P($G(^AUTTREVN(X,0)),U),1:$P($G(^AUTTREVN(X,0)),U))
  1.  Q ABMRVCD