ABMDBDIC ; IHS/ASDST/DMJ - Bill Selection ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
;IHS/DSD/MRS - 5/21/1999 - NOIS QDA-599-130046 Patch 3 #1
; Added check for missing insurer data
;
;IHS/PIMC/JLG - 8/20/02 - V2.5 P2
; Modified so IQMG option would only look at one bill. Thanks to
; Jim Gray for the code.
;
; IHS/SD/SDR - v2.5 p11 - Adrian supplied the following changes
;
; IHS/SD/SDR - v2.5 p12 - Added code to look up by UFMS invoice number
; using x-ref UINV
;
BILL ;EP - SELECT BILL
K %P,DIC,ABMP("BDFN"),ABM
S DIR("A")="Select BILL or PATIENT"
S DIR("?")="Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
W !
S DIR(0)="FO" D ^DIR K DIR
Q:$D(DIRUT)
S ABM("INPUT")=Y
I Y=" " D Q
.S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EMQ",X=Y
.D ^DIC Q:+Y<0
.S ABMP("BDFN")=+Y
I ($D(^ABMDBILL(DUZ(2),"B",Y))&(Y'=+Y))!($D(^ABMDBILL(DUZ(2),"UINV",Y))) D
.S X=Y
.S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EM" D ^DIC
.I +Y>0 S ABMP("BDFN")=+Y
I $G(ABMP("BDFN")) K ABM Q
I Y=+Y,$D(^ABMDBILL(DUZ(2),"B",Y)) D
.S X=Y
.S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EM" D ^DIC
.I +Y>0 D
..S ABMP("BDFN")=+Y
..K DIR,DIE,DIC,X,Y,DA
..S DIR(0)="Y"
..S DIR("A")="Correct Bill",DIR("B")="YES" D ^DIR K DIR
..I Y'=1 K ABMP("BDFN")
I $G(ABMP("BDFN")) K ABM Q
S ABM("STATUS")=$P(^DD(9002274.4,.04,0),"^",3)
NUM ;NUMBER LOOKUP
S Y=ABM("INPUT")
I +Y D
.S J=+Y_" "
.S ABM("CNT")=0
.F S J=$O(^ABMDBILL(DUZ(2),"B",J)) Q:J'[+ABM("INPUT")!($G(ABMP("BDFN"))) D
..S I=$O(^ABMDBILL(DUZ(2),"B",J,0))
..S ABMP("PDFN")=$P(^ABMDBILL(DUZ(2),I,0),"^",5)
..D ID
.D:(ABM("CNT")#5) SEL
I $G(ABMP("BDFN")) K ABM Q
PAT ;PATIENT LOOKUP
S X=ABM("INPUT"),DIC="^AUPNPAT(",DIC(0)="EMQ",AUPNLK("ALL")=1
D ^DIC
I +Y<0 G BILL
S ABMP("PDFN")=+Y,ABM("P0")=^DPT(ABMP("PDFN"),0)
S $P(ABM("="),"=",80)=""
D PAT^ABMDUTL(ABMP("PDFN"))
S I="",ABM("CNT")=0 F S I=$O(^ABMDBILL(DUZ(2),"D",ABMP("PDFN"),I),-1) Q:'I!($G(ABMP("BDFN")))!($D(DIRUT)) D ID
D:(ABM("CNT")#5) SEL
I '$G(ABMP("BDFN")) G BILL
K ABM Q
ID ;BILL IDENTIFIERS
I '(ABM("CNT")#5) D PAT^ABMDUTL(ABMP("PDFN"))
S ABM("CNT")=ABM("CNT")+1
S ABM("CNT",ABM("CNT"))=I
W !!,"(",ABM("CNT"),")"
S ABM("ZERO")=^ABMDBILL(DUZ(2),I,0) N J F J=1:1:12 S ABM(J)=$P(ABM("ZERO"),"^",J)
S ABM(7,1)=$P($G(^ABMDBILL(DUZ(2),I,7)),"^",1),ABM(2,1)=$P($G(^(2)),"^",1)
S ABM(4)=$P(ABM("STATUS"),ABM(4)_":",2),ABM(4)=$P(ABM(4),";",1)
W ?5,"Bill# ",ABM(1)
W ?20,$$SDT^ABMDUTL(ABM(7,1))
;Realignment of bill inquiry
W ?32,$E($P($G(^ABMDVTYP(+ABM(7),0)),U),1,17)
;Realignment of bill inquiry
W ?51,$E($P($G(^DIC(40.7,+ABM(10),0)),U),1,13)
W ?67,$P($G(^AUTTLOC(+ABM(3),0)),"^",2)
W !,?6,$P($G(^ABMDEXP(+ABM(6),0)),"^",1)
;realignment of Bill Inquiry
W ?22,$E(ABM(4),1,15)
W ?37,$P($G(^AUTNINS(+ABM(8),0)),"^",1)
W ?70,$J($FN(ABM(2,1),",",2),10)
I '(ABM("CNT")#5) D SEL
Q
SEL ;SELECT
F W ! Q:$Y+4>IOSL
S DIR(0)="NAO^1:"_ABM("CNT"),DIR("A")="Select 1 to "_ABM("CNT")_": " D ^DIR K DIR
I Y S ABMP("BDFN")=ABM("CNT",Y)
I Y="",'$D(DTOUT) K DIRUT
Q
;
BENT ;EP - for doing Bill File lookup with DIC variables
K ABMP("BDFN")
S AUPNLK("ALL")=1
S DIC("W")="S ABM(0)=^(0),ABM(2)=+$G(^(2)),ABM(7)=$S(+$G(^(7)):^(7),1:+$G(^(6))) D DICW^ABMDBDIC"
D ^DIC K DIC
G XIT:X=""!$D(DUOUT)!$D(DTOUT)
I X="?" W !!,"Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
G BENT:+Y<1 S ABMP("BDFN")=+Y
G XIT
;
DICW ;EP - for displaying bill identifiers
I $G(DZ)["?",$P(ABM(0),U,5),$D(^DPT($P(ABM(0),U,5),0)) S ABMDPT=^(0) D
.W ?12,$P(ABMDPT,U)
.W ?46,$P(ABMDPT,U,2)," "
.W $$HDT^ABMDUTL($P(ABMDPT,U,3))
.W " ",$P(ABMDPT,U,9)
I I $G(DUZ(2)),$D(^AUPNPAT($P(ABM(0),U,5),41,DUZ(2),0)) W ?68,$P($G(^AUTTLOC(DUZ(2),0)),U,7)," ",$P(^AUPNPAT($P(ABM(0),U,5),41,DUZ(2),0),U,2)
I $G(X)'=$P(ABM(0),U,5)!($G(DZ)["?") W !
W ?17,"Visit: ",$$HDT^ABMDUTL(ABM(7))," "
I $P(ABM(0),U,7) W $E($P($G(^ABMDVTYP($P(ABM(0),U,7),0)),U),1,14)
I $P(ABM(0),U,10),$P(ABM(0),U,3) W ?49,$E($P($G(^DIC(40.7,$P(ABM(0),U,10),0)),U),1,17),?68,$E($P($G(^AUTTLOC($P(ABM(0),U,3),0)),U,2),1,12)
I $P(ABM(0),U,8) W !?20,"Bill: ",$P(^AUTNINS($P(ABM(0),U,8),0),U)
I $P(ABM(0),U,6) W ?57,$P($G(^ABMDEXP($P(ABM(0),U,6),0)),U)
W ?68,$J($FN(ABM(2),",",2),10)
S DIW=1
I $G(DZ)["?" W !
K ABM(0),ABM(7)
Q
;
XIT K ABM
Q
;
MULT ;EP for Selecting Multiple Bills
K DIC S ABM("C")=0,DIC="^ABMDBILL(DUZ(2),",DIC(0)="QEAM" W !
F ABM=1:1 W ! D Q:X=""!$D(DUOUT)!$D(DTOUT)
SELO .S ABM("E")=$E(ABM,$L(ABM)),DIC("A")="Select "_ABM_$S(ABM>3&(ABM<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL: ",DIC(0)="QEAM" D ^DIC
.Q:X=""!$D(DUOUT)!$D(DTOUT)
.I +Y<1 G SELO
.S ABMM(+Y)=""
K DIC
G XIT
ABMDBDIC ; IHS/ASDST/DMJ - Bill Selection ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ;IHS/DSD/MRS - 5/21/1999 - NOIS QDA-599-130046 Patch 3 #1
+4 ; Added check for missing insurer data
+5 ;
+6 ;IHS/PIMC/JLG - 8/20/02 - V2.5 P2
+7 ; Modified so IQMG option would only look at one bill. Thanks to
+8 ; Jim Gray for the code.
+9 ;
+10 ; IHS/SD/SDR - v2.5 p11 - Adrian supplied the following changes
+11 ;
+12 ; IHS/SD/SDR - v2.5 p12 - Added code to look up by UFMS invoice number
+13 ; using x-ref UINV
+14 ;
BILL ;EP - SELECT BILL
+1 KILL %P,DIC,ABMP("BDFN"),ABM
+2 SET DIR("A")="Select BILL or PATIENT"
+3 SET DIR("?")="Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
+4 WRITE !
+5 SET DIR(0)="FO"
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET ABM("INPUT")=Y
+8 IF Y=" "
Begin DoDot:1
+9 SET DIC="^ABMDBILL(DUZ(2),"
SET DIC(0)="EMQ"
SET X=Y
+10 DO ^DIC
IF +Y<0
QUIT
+11 SET ABMP("BDFN")=+Y
End DoDot:1
QUIT
+12 IF ($DATA(^ABMDBILL(DUZ(2),"B",Y))&(Y'=+Y))!($DATA(^ABMDBILL(DUZ(2),"UINV",Y)))
Begin DoDot:1
+13 SET X=Y
+14 SET DIC="^ABMDBILL(DUZ(2),"
SET DIC(0)="EM"
DO ^DIC
+15 IF +Y>0
SET ABMP("BDFN")=+Y
End DoDot:1
+16 IF $GET(ABMP("BDFN"))
KILL ABM
QUIT
+17 IF Y=+Y
IF $DATA(^ABMDBILL(DUZ(2),"B",Y))
Begin DoDot:1
+18 SET X=Y
+19 SET DIC="^ABMDBILL(DUZ(2),"
SET DIC(0)="EM"
DO ^DIC
+20 IF +Y>0
Begin DoDot:2
+21 SET ABMP("BDFN")=+Y
+22 KILL DIR,DIE,DIC,X,Y,DA
+23 SET DIR(0)="Y"
+24 SET DIR("A")="Correct Bill"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+25 IF Y'=1
KILL ABMP("BDFN")
End DoDot:2
End DoDot:1
+26 IF $GET(ABMP("BDFN"))
KILL ABM
QUIT
+27 SET ABM("STATUS")=$PIECE(^DD(9002274.4,.04,0),"^",3)
NUM ;NUMBER LOOKUP
+1 SET Y=ABM("INPUT")
+2 IF +Y
Begin DoDot:1
+3 SET J=+Y_" "
+4 SET ABM("CNT")=0
+5 FOR
SET J=$ORDER(^ABMDBILL(DUZ(2),"B",J))
IF J'[+ABM("INPUT")!($GET(ABMP("BDFN")))
QUIT
Begin DoDot:2
+6 SET I=$ORDER(^ABMDBILL(DUZ(2),"B",J,0))
+7 SET ABMP("PDFN")=$PIECE(^ABMDBILL(DUZ(2),I,0),"^",5)
+8 DO ID
End DoDot:2
+9 IF (ABM("CNT")#5)
DO SEL
End DoDot:1
+10 IF $GET(ABMP("BDFN"))
KILL ABM
QUIT
PAT ;PATIENT LOOKUP
+1 SET X=ABM("INPUT")
SET DIC="^AUPNPAT("
SET DIC(0)="EMQ"
SET AUPNLK("ALL")=1
+2 DO ^DIC
+3 IF +Y<0
GOTO BILL
+4 SET ABMP("PDFN")=+Y
SET ABM("P0")=^DPT(ABMP("PDFN"),0)
+5 SET $PIECE(ABM("="),"=",80)=""
+6 DO PAT^ABMDUTL(ABMP("PDFN"))
+7 SET I=""
SET ABM("CNT")=0
FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),"D",ABMP("PDFN"),I),-1)
IF 'I!($GET(ABMP("BDFN")))!($DATA(DIRUT))
QUIT
DO ID
+8 IF (ABM("CNT")#5)
DO SEL
+9 IF '$GET(ABMP("BDFN"))
GOTO BILL
+10 KILL ABM
QUIT
ID ;BILL IDENTIFIERS
+1 IF '(ABM("CNT")#5)
DO PAT^ABMDUTL(ABMP("PDFN"))
+2 SET ABM("CNT")=ABM("CNT")+1
+3 SET ABM("CNT",ABM("CNT"))=I
+4 WRITE !!,"(",ABM("CNT"),")"
+5 SET ABM("ZERO")=^ABMDBILL(DUZ(2),I,0)
NEW J
FOR J=1:1:12
SET ABM(J)=$PIECE(ABM("ZERO"),"^",J)
+6 SET ABM(7,1)=$PIECE($GET(^ABMDBILL(DUZ(2),I,7)),"^",1)
SET ABM(2,1)=$PIECE($GET(^(2)),"^",1)
+7 SET ABM(4)=$PIECE(ABM("STATUS"),ABM(4)_":",2)
SET ABM(4)=$PIECE(ABM(4),";",1)
+8 WRITE ?5,"Bill# ",ABM(1)
+9 WRITE ?20,$$SDT^ABMDUTL(ABM(7,1))
+10 ;Realignment of bill inquiry
+11 WRITE ?32,$EXTRACT($PIECE($GET(^ABMDVTYP(+ABM(7),0)),U),1,17)
+12 ;Realignment of bill inquiry
+13 WRITE ?51,$EXTRACT($PIECE($GET(^DIC(40.7,+ABM(10),0)),U),1,13)
+14 WRITE ?67,$PIECE($GET(^AUTTLOC(+ABM(3),0)),"^",2)
+15 WRITE !,?6,$PIECE($GET(^ABMDEXP(+ABM(6),0)),"^",1)
+16 ;realignment of Bill Inquiry
+17 WRITE ?22,$EXTRACT(ABM(4),1,15)
+18 WRITE ?37,$PIECE($GET(^AUTNINS(+ABM(8),0)),"^",1)
+19 WRITE ?70,$JUSTIFY($FNUMBER(ABM(2,1),",",2),10)
+20 IF '(ABM("CNT")#5)
DO SEL
+21 QUIT
SEL ;SELECT
+1 FOR
WRITE !
IF $Y+4>IOSL
QUIT
+2 SET DIR(0)="NAO^1:"_ABM("CNT")
SET DIR("A")="Select 1 to "_ABM("CNT")_": "
DO ^DIR
KILL DIR
+3 IF Y
SET ABMP("BDFN")=ABM("CNT",Y)
+4 IF Y=""
IF '$DATA(DTOUT)
KILL DIRUT
+5 QUIT
+6 ;
BENT ;EP - for doing Bill File lookup with DIC variables
+1 KILL ABMP("BDFN")
+2 SET AUPNLK("ALL")=1
+3 SET DIC("W")="S ABM(0)=^(0),ABM(2)=+$G(^(2)),ABM(7)=$S(+$G(^(7)):^(7),1:+$G(^(6))) D DICW^ABMDBDIC"
+4 DO ^DIC
KILL DIC
+5 IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+6 IF X="?"
WRITE !!,"Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
+7 IF +Y<1
GOTO BENT
SET ABMP("BDFN")=+Y
+8 GOTO XIT
+9 ;
DICW ;EP - for displaying bill identifiers
+1 IF $GET(DZ)["?"
IF $PIECE(ABM(0),U,5)
IF $DATA(^DPT($PIECE(ABM(0),U,5),0))
SET ABMDPT=^(0)
Begin DoDot:1
+2 WRITE ?12,$PIECE(ABMDPT,U)
+3 WRITE ?46,$PIECE(ABMDPT,U,2)," "
+4 WRITE $$HDT^ABMDUTL($PIECE(ABMDPT,U,3))
+5 WRITE " ",$PIECE(ABMDPT,U,9)
End DoDot:1
+6 IF $TEST
IF $GET(DUZ(2))
IF $DATA(^AUPNPAT($PIECE(ABM(0),U,5),41,DUZ(2),0))
WRITE ?68,$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,7)," ",$PIECE(^AUPNPAT($PIECE(ABM(0),U,5),41,DUZ(2),0),U,2)
+7 IF $GET(X)'=$PIECE(ABM(0),U,5)!($GET(DZ)["?")
WRITE !
+8 WRITE ?17,"Visit: ",$$HDT^ABMDUTL(ABM(7))," "
+9 IF $PIECE(ABM(0),U,7)
WRITE $EXTRACT($PIECE($GET(^ABMDVTYP($PIECE(ABM(0),U,7),0)),U),1,14)
+10 IF $PIECE(ABM(0),U,10)
IF $PIECE(ABM(0),U,3)
WRITE ?49,$EXTRACT($PIECE($GET(^DIC(40.7,$PIECE(ABM(0),U,10),0)),U),1,17),?68,$EXTRACT($PIECE($GET(^AUTTLOC($PIECE(ABM(0),U,3),0)),U,2),1,12)
+11 IF $PIECE(ABM(0),U,8)
WRITE !?20,"Bill: ",$PIECE(^AUTNINS($PIECE(ABM(0),U,8),0),U)
+12 IF $PIECE(ABM(0),U,6)
WRITE ?57,$PIECE($GET(^ABMDEXP($PIECE(ABM(0),U,6),0)),U)
+13 WRITE ?68,$JUSTIFY($FNUMBER(ABM(2),",",2),10)
+14 SET DIW=1
+15 IF $GET(DZ)["?"
WRITE !
+16 KILL ABM(0),ABM(7)
+17 QUIT
+18 ;
XIT KILL ABM
+1 QUIT
+2 ;
MULT ;EP for Selecting Multiple Bills
+1 KILL DIC
SET ABM("C")=0
SET DIC="^ABMDBILL(DUZ(2),"
SET DIC(0)="QEAM"
WRITE !
+2 FOR ABM=1:1
WRITE !
Begin DoDot:1
SELO SET ABM("E")=$EXTRACT(ABM,$LENGTH(ABM))
SET DIC("A")="Select "_ABM_$SELECT(ABM>3&(ABM<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL: "
SET DIC(0)="QEAM"
DO ^DIC
+1 IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+2 IF +Y<1
GOTO SELO
+3 SET ABMM(+Y)=""
End DoDot:1
IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+4 KILL DIC
+5 GOTO XIT
