ABMDEDIC ; IHS/ASDST/DMJ - Claim Selection ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
CLM ;SELECT CLAIM
K ABMP("CDFN")
S DIR("A")="Select CLAIM or PATIENT"
S DIR("?")="Enter either the Claim Number or a Patient Identifier (Name, HRN, SSN, DOB)"
S DIR(0)="FO" D ^DIR K DIR
Q:$D(DIRUT)
S ABM("INPUT")=Y
I Y=" " D Q
.S X=Y,DIC="^ABMDCLM(DUZ(2),",DIC(0)="EMQ" D ^DIC
.Q:+Y<0
.S ABMP("CDFN")=+Y
I $D(^ABMDCLM(DUZ(2),+Y,0)) D
.Q:$P($G(^ABMDCLM(DUZ(2),+Y,0)),U)=""
.S DIC("W")="S ABMP(0)=^(0) D DICW^ABMDEDIC"
.S ABMP("CDFN")=+Y
.S X=Y,DIC="^ABMDCLM(DUZ(2),",DIC(0)="EM" D ^DIC
.S DIR(0)="Y",DIR("A")="Correct Claim",DIR("B")="YES"
.D ^DIR K DIR
.I Y'=1 K ABMP("CDFN")
I $G(ABMP("CDFN")) G XIT
PAT ;PATIENT LOOKUP
S X=ABM("INPUT"),DIC="^AUPNPAT(",DIC(0)="EMQ",AUPNLK("ALL")=1
D ^DIC
I +Y<0 G CLM
S ABM("STATUS")=$P(^DD(9002274.3,.04,0),"^",3)
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(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),I),-1) Q:'I!($G(ABMP("CDFN")))!($D(DIRUT)) D
.Q:$G(^ABMDCLM(DUZ(2),I,0))=""
.I '(ABM("CNT")#5) D PAT^ABMDUTL(ABMP("PDFN"))
.S ABM("CNT")=ABM("CNT")+1
.S ABM("CNT",ABM("CNT"))=I
.W !!,"(",ABM("CNT"),")"
.W ?5,"Claim# ",I
.S ABM("ZERO")=$G(^ABMDCLM(DUZ(2),I,0)) N J F J=1:1:8 S ABM(J)=$P(ABM("ZERO"),U,J)
.S ABM(4)=$P(ABM("STATUS"),ABM(4)_":",2),ABM(4)=$P(ABM(4),";",1)
.W ?20,$$SDT^ABMDUTL(ABM(2))
.W ?31,$P($G(^ABMDVTYP(+ABM(7),0)),U)
.W ?55,$P($G(^DIC(40.7,+ABM(6),0)),U)
.W !,?6,$P($G(^AUTTLOC(+ABM(3),0)),U,2)
.W ?21,$P($G(^AUTNINS(+ABM(8),0)),U)
.W ?50,"Status: ",ABM(4)
.I '(ABM("CNT")#5) D SEL
I (ABM("CNT")#5) D SEL
I '$G(ABMP("CDFN")) G CLM
G XIT
SEL ;SELECT
Q:$G(ABMP("CDFN"))
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("CDFN")=ABM("CNT",Y)
I Y="",'$D(DTOUT) K DIRUT
Q
;
DICW ;EP - for displaying claim identifiers
I $G(DZ)["?" W ?46,$P(^DPT(+ABMP(0),0),U,2)," ",$$HDT^ABMDUTL($P(^(0),U,3))," ",$P(^(0),U,9)
I I $G(DUZ(2)),$D(^AUPNPAT(+ABMP(0),41,DUZ(2),0)) W ?68,$P($G(^AUTTLOC(DUZ(2),0)),U,7)," ",$P(^AUPNPAT(+ABMP(0),41,DUZ(2),0),U,2)
I $G(X)'=+ABMP(0)!($G(DZ)["?") W !
W ?17,"Clm:",Y," ",$$HDT^ABMDUTL($P(ABMP(0),U,2))," "
I $P(ABMP(0),U,7) W $E($P($G(^ABMDVTYP($P(ABMP(0),U,7),0)),U),1,12)
I $P(ABMP(0),U,6),$P(ABMP(0),U,3) W ?51,$E($P($G(^DIC(40.7,$P(ABMP(0),U,6),0)),U),1,15),?68,$E($P($G(^AUTTLOC($P(ABMP(0),U,3),0)),U,2),1,12)
I $P(ABMP(0),U,8) W !?25,$E($P($G(^AUTNINS($P(ABMP(0),U,8),0)),U),1,30)
I $P(ABMP(0),U,4)]"",$D(^DD(9002274.3,.04,0)) W ?57,$E($P($P($P(^(0),U,3),$P(ABMP(0),U,4)_":",2),";"),1,20)
S DIW=1
K ABMP(0)
Q
;
CLM1 W !! K %P,DIR,DIC S DIR("A")="Select CLAIM or PATIENT",DIR(0)="FO^1:30",DIR("?")="Select the CLAIM NUMBER or a PATIENT IDENTIFIER"
S ABM("D")="^ABMDCLM(DUZ(2),",ABM("D0")="QZEM"
S DIR("?",1)="Enter either the Claim Number or a Patient Identifier (Name, HRN, SSN, DOB)"
S DIR("?",2)=""
S DIR("?")=" (NOTE: Existing Claims are displayed by entering ""??"")"
S DIR("??")="^S X=""??"",DIC=ABM(""D""),DIC(0)=ABM(""D0"") D ^DIC"
D ^DIR K DIR,ABM
G XIT:$D(DIROUT)!$D(DIRUT)!$D(DUOUT)!$D(DTOUT)
S DIC="^ABMDCLM(DUZ(2),",DIC(0)="ZMIE" D ^DIC K DIC
G CLM1:+Y<1 S ABMP("CDFN")=+Y
G XIT
;
XIT K ABM,AUPNLK("ALL")
Q
;
MULT ;EP for Selecting Multiple Claims
S AUPNLK("ALL")=1
K DIC S ABM("C")=0,DIC="^ABMDCLM(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")_" CLAIM: ",DIC(0)="QEAM" D ^DIC
.Q:X=""!$D(DUOUT)!$D(DTOUT)
.I +Y<1 G SELO
.S ABMM(+Y)=""
K DIC
G XIT
ABMDEDIC ; IHS/ASDST/DMJ - Claim Selection ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
CLM ;SELECT CLAIM
+1 KILL ABMP("CDFN")
+2 SET DIR("A")="Select CLAIM or PATIENT"
+3 SET DIR("?")="Enter either the Claim Number or a Patient Identifier (Name, HRN, SSN, DOB)"
+4 SET DIR(0)="FO"
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET ABM("INPUT")=Y
+7 IF Y=" "
Begin DoDot:1
+8 SET X=Y
SET DIC="^ABMDCLM(DUZ(2),"
SET DIC(0)="EMQ"
DO ^DIC
+9 IF +Y<0
QUIT
+10 SET ABMP("CDFN")=+Y
End DoDot:1
QUIT
+11 IF $DATA(^ABMDCLM(DUZ(2),+Y,0))
Begin DoDot:1
+12 IF $PIECE($GET(^ABMDCLM(DUZ(2),+Y,0)),U)=""
QUIT
+13 SET DIC("W")="S ABMP(0)=^(0) D DICW^ABMDEDIC"
+14 SET ABMP("CDFN")=+Y
+15 SET X=Y
SET DIC="^ABMDCLM(DUZ(2),"
SET DIC(0)="EM"
DO ^DIC
+16 SET DIR(0)="Y"
SET DIR("A")="Correct Claim"
SET DIR("B")="YES"
+17 DO ^DIR
KILL DIR
+18 IF Y'=1
KILL ABMP("CDFN")
End DoDot:1
+19 IF $GET(ABMP("CDFN"))
GOTO XIT
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 CLM
+4 SET ABM("STATUS")=$PIECE(^DD(9002274.3,.04,0),"^",3)
+5 SET ABMP("PDFN")=+Y
SET ABM("P0")=^DPT(ABMP("PDFN"),0)
+6 SET $PIECE(ABM("="),"=",80)=""
+7 DO PAT^ABMDUTL(ABMP("PDFN"))
+8 SET I=""
SET ABM("CNT")=0
FOR
SET I=$ORDER(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),I),-1)
IF 'I!($GET(ABMP("CDFN")))!($DATA(DIRUT))
QUIT
Begin DoDot:1
+9 IF $GET(^ABMDCLM(DUZ(2),I,0))=""
QUIT
+10 IF '(ABM("CNT")#5)
DO PAT^ABMDUTL(ABMP("PDFN"))
+11 SET ABM("CNT")=ABM("CNT")+1
+12 SET ABM("CNT",ABM("CNT"))=I
+13 WRITE !!,"(",ABM("CNT"),")"
+14 WRITE ?5,"Claim# ",I
+15 SET ABM("ZERO")=$GET(^ABMDCLM(DUZ(2),I,0))
NEW J
FOR J=1:1:8
SET ABM(J)=$PIECE(ABM("ZERO"),U,J)
+16 SET ABM(4)=$PIECE(ABM("STATUS"),ABM(4)_":",2)
SET ABM(4)=$PIECE(ABM(4),";",1)
+17 WRITE ?20,$$SDT^ABMDUTL(ABM(2))
+18 WRITE ?31,$PIECE($GET(^ABMDVTYP(+ABM(7),0)),U)
+19 WRITE ?55,$PIECE($GET(^DIC(40.7,+ABM(6),0)),U)
+20 WRITE !,?6,$PIECE($GET(^AUTTLOC(+ABM(3),0)),U,2)
+21 WRITE ?21,$PIECE($GET(^AUTNINS(+ABM(8),0)),U)
+22 WRITE ?50,"Status: ",ABM(4)
+23 IF '(ABM("CNT")#5)
DO SEL
End DoDot:1
+24 IF (ABM("CNT")#5)
DO SEL
+25 IF '$GET(ABMP("CDFN"))
GOTO CLM
+26 GOTO XIT
SEL ;SELECT
+1 IF $GET(ABMP("CDFN"))
QUIT
+2 FOR
WRITE !
IF $Y+4>IOSL
QUIT
+3 SET DIR(0)="NAO^1:"_ABM("CNT")
SET DIR("A")="Select 1 to "_ABM("CNT")_": "
DO ^DIR
KILL DIR
+4 IF Y
SET ABMP("CDFN")=ABM("CNT",Y)
+5 IF Y=""
IF '$DATA(DTOUT)
KILL DIRUT
+6 QUIT
+7 ;
DICW ;EP - for displaying claim identifiers
+1 IF $GET(DZ)["?"
WRITE ?46,$PIECE(^DPT(+ABMP(0),0),U,2)," ",$$HDT^ABMDUTL($PIECE(^(0),U,3))," ",$PIECE(^(0),U,9)
+2 IF $TEST
IF $GET(DUZ(2))
IF $DATA(^AUPNPAT(+ABMP(0),41,DUZ(2),0))
WRITE ?68,$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,7)," ",$PIECE(^AUPNPAT(+ABMP(0),41,DUZ(2),0),U,2)
+3 IF $GET(X)'=+ABMP(0)!($GET(DZ)["?")
WRITE !
+4 WRITE ?17,"Clm:",Y," ",$$HDT^ABMDUTL($PIECE(ABMP(0),U,2))," "
+5 IF $PIECE(ABMP(0),U,7)
WRITE $EXTRACT($PIECE($GET(^ABMDVTYP($PIECE(ABMP(0),U,7),0)),U),1,12)
+6 IF $PIECE(ABMP(0),U,6)
IF $PIECE(ABMP(0),U,3)
WRITE ?51,$EXTRACT($PIECE($GET(^DIC(40.7,$PIECE(ABMP(0),U,6),0)),U),1,15),?68,$EXTRACT($PIECE($GET(^AUTTLOC($PIECE(ABMP(0),U,3),0)),U,2),1,12)
+7 IF $PIECE(ABMP(0),U,8)
WRITE !?25,$EXTRACT($PIECE($GET(^AUTNINS($PIECE(ABMP(0),U,8),0)),U),1,30)
+8 IF $PIECE(ABMP(0),U,4)]""
IF $DATA(^DD(9002274.3,.04,0))
WRITE ?57,$EXTRACT($PIECE($PIECE($PIECE(^(0),U,3),$PIECE(ABMP(0),U,4)_":",2),";"),1,20)
+9 SET DIW=1
+10 KILL ABMP(0)
+11 QUIT
+12 ;
CLM1 WRITE !!
KILL %P,DIR,DIC
SET DIR("A")="Select CLAIM or PATIENT"
SET DIR(0)="FO^1:30"
SET DIR("?")="Select the CLAIM NUMBER or a PATIENT IDENTIFIER"
+1 SET ABM("D")="^ABMDCLM(DUZ(2),"
SET ABM("D0")="QZEM"
+2 SET DIR("?",1)="Enter either the Claim Number or a Patient Identifier (Name, HRN, SSN, DOB)"
+3 SET DIR("?",2)=""
+4 SET DIR("?")=" (NOTE: Existing Claims are displayed by entering ""??"")"
+5 SET DIR("??")="^S X=""??"",DIC=ABM(""D""),DIC(0)=ABM(""D0"") D ^DIC"
+6 DO ^DIR
KILL DIR,ABM
+7 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+8 SET DIC="^ABMDCLM(DUZ(2),"
SET DIC(0)="ZMIE"
DO ^DIC
KILL DIC
+9 IF +Y<1
GOTO CLM1
SET ABMP("CDFN")=+Y
+10 GOTO XIT
+11 ;
XIT KILL ABM,AUPNLK("ALL")
+1 QUIT
+2 ;
MULT ;EP for Selecting Multiple Claims
+1 SET AUPNLK("ALL")=1
+2 KILL DIC
SET ABM("C")=0
SET DIC="^ABMDCLM(DUZ(2),"
SET DIC(0)="QEAM"
WRITE !
+3 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")_" CLAIM: "
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
