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