ABMDRSU2 ; IHS/ASDST/DMJ - Summarized Claim Display-PART 2 ;
;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
;Original;TMD;
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - updated DX^ABMCVAPI call to be numeric
;
GPRV ;
K ABMX
S ABM(0)=""
F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM(0))) Q:ABM(0)="" S ABMX(0)=$O(^(ABM(0),"")) D S ABMX(ABM)=ABM("X")
.S ABM("X")=""
.S ABMX(0)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX(0),0)),U)
.Q:ABMX(0)=""
.Q:'$D(^VA(200,ABMX(0)))
.N X0
.S X0=$P($G(^VA(200,ABMX(0),"PS")),U,5)
.I X0="" S ABM("ERR")=ABM("ERR")+1,ABM("ERR",ABM("ERR"))="Provider: "_$P(^VA(200,ABMX(0),0),U)_" does not have a PROVIDER DISCIPLINE entry" Q
.S ABMX(0)=X0
.Q:'$D(^DIC(7,ABMX(0),0)) S ABM("X")=$E($P(^(0),U,1),1,16)
.Q
;
I '$D(ABMX(1)) S ABMX(1)="no providers"
GPOV ;
S ABM(0)=""
F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM(0))) Q:ABM(0)="" S ABMX(0)=$O(^(ABM(0),"")) D CHKPOV S $P(ABMX(ABM),U,2)=ABM("X")
I $P(ABMX(1),U,2)="" S $P(ABMX(1),U,2)="no primary DX"
G GPRC
;
CHKPOV ;
S ABM("X")=""
S ABMX(0)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMX(0),0)),U)
Q:ABMX(0)=""
;Q:'$D(^ICD9(ABMX(0),0)) S ABM("X")=$E($P($$DX^ABMCVAPI(ABMX(0),""),U,4),1,28) ;abm*2.6*14 update API call
Q:'$D(^ICD9(ABMX(0),0)) S ABM("X")=$E($P($$DX^ABMCVAPI(+ABMX(0),""),U,4),1,28) ;abm*2.6*14 update API call
Q
;
GPRC ;
S ABM(0)=""
F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM(0))) Q:ABM(0)="" S ABMX(0)=$O(^(ABM(0),"")) D CHKPRC S $P(ABMX(ABM),U,3)=ABM("X")
I $P(ABMX(1),U,3)="" S $P(ABMX(1),U,3)="no procedures"
G PWRT
;
CHKPRC ;
S ABM("X")=""
S ABMX(0)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMX(0),0)),U)
Q:ABMX(0)=""
Q:'$D(^ICD0(ABMX(0),0)) S ABM("X")=$E($P($$ICDOP^ABMCVAPI(ABMX(0),""),U,5),1,27) ;CSV-c
Q
;
PWRT ;
S ABM=0
F S ABM=$O(ABMX(ABM)) Q:ABM=""
I $Y>(IOSL-(8+ABM)) S ABM("CONT")="" D HEAD^ABMDRSU1 Q:$D(ABMP("QUIT")) D HD^ABMDRSU1
W !!?4,"ICD Diagnosis",?34,"Procedure Narrative",?63,"Provider Class"
W !,?4,"----------------------------",?34,"---------------------------",?63,"----------------"
S ABM=0
F S ABM=$O(ABMX(ABM)) Q:ABM="" D WRT Q:$D(ABMP("QUIT"))
I $D(ABMP("QUIT")) G XIT
G GINS
;
WRT ;
W !?4,$P(ABMX(ABM),U,2),?34,$P(ABMX(ABM),U,3),?63,$P(ABMX(ABM),U)
Q
;
GINS ;
K ABMX
S ABM(0)=0
F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0))) Q:'ABM(0) S ABM("INSCO")=$P(^(ABM(0),0),U) D CHKINS S ABMX(ABM)=ABM("X")
G IWRT
;
CHKINS ;
S ABM("X")=""
Q:'$D(^AUTNINS(ABM("INSCO"),0)) S ABM("X")=$E($P(^(0),U),1,30)
;
COV ;
S ABM("G")=0,ABM("C")=""
F S ABM("G")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0),11,ABM("G"))) Q:'ABM("G") S ABM("C")=$S(ABM("C")]"":ABM("C")_";"_$P(^AUTTPIC(ABM("G"),0),U),1:$P(^AUTTPIC(ABM("G"),0),U))
S $P(ABM("X"),U,2)=ABM("C")
S $P(ABM("X"),U,4)=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0),0),U,3)="F":"FLAGGED",$P(^(0),U,3)="U":"BILLED",$P(^(0),U,3)="I":"ACTIVE",$P(^(0),U,3)="C":"COMPLETED",1:"PENDING")
Q
;
IWRT ;
S ABM=0
F S ABM=$O(ABMX(ABM)) Q:ABM=""
I $Y>(IOSL-(4+ABM)) S ABM("CONT")="" D HEAD^ABMDRSU1 Q:$D(ABMP("QUIT")) D HD^ABMDRSU1
W !!,?4,"Insurance Company",?38,"Coverage Types",?68,"Status"
W !?4 F I=1:1:75 W "-"
S ABM=0
F S ABM=$O(ABMX(ABM)) Q:ABM="" D IWRT1 Q:$D(ABMP("QUIT"))
I $D(ABMP("QUIT")) G XIT
I $Y'>(IOSL-10) W !!!,ABM("80E")
K ABMX
Q
;
IWRT1 ;
W !?4,$P(ABMX(ABM),U,1),?40,$P(ABMX(ABM),U,2),?42,$P(ABMX(ABM),U,3),?68,$P(ABMX(ABM),U,4)
Q
;
XIT Q
ABMDRSU2 ; IHS/ASDST/DMJ - Summarized Claim Display-PART 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
+2 ;Original;TMD;
+3 ;
+4 ; IHS/SD/SDR - v2.6 CSV
+5 ;IHS/SD/SDR - 2.6*14 - updated DX^ABMCVAPI call to be numeric
+6 ;
GPRV ;
+1 KILL ABMX
+2 SET ABM(0)=""
+3 FOR ABM=1:1
SET ABM(0)=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM(0)))
IF ABM(0)=""
QUIT
SET ABMX(0)=$ORDER(^(ABM(0),""))
Begin DoDot:1
+4 SET ABM("X")=""
+5 SET ABMX(0)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX(0),0)),U)
+6 IF ABMX(0)=""
QUIT
+7 IF '$DATA(^VA(200,ABMX(0)))
QUIT
+8 NEW X0
+9 SET X0=$PIECE($GET(^VA(200,ABMX(0),"PS")),U,5)
+10 IF X0=""
SET ABM("ERR")=ABM("ERR")+1
SET ABM("ERR",ABM("ERR"))="Provider: "_$PIECE(^VA(200,ABMX(0),0),U)_" does not have a PROVIDER DISCIPLINE entry"
QUIT
+11 SET ABMX(0)=X0
+12 IF '$DATA(^DIC(7,ABMX(0),0))
QUIT
SET ABM("X")=$EXTRACT($PIECE(^(0),U,1),1,16)
+13 QUIT
End DoDot:1
SET ABMX(ABM)=ABM("X")
+14 ;
+15 IF '$DATA(ABMX(1))
SET ABMX(1)="no providers"
GPOV ;
+1 SET ABM(0)=""
+2 FOR ABM=1:1
SET ABM(0)=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM(0)))
IF ABM(0)=""
QUIT
SET ABMX(0)=$ORDER(^(ABM(0),""))
DO CHKPOV
SET $PIECE(ABMX(ABM),U,2)=ABM("X")
+3 IF $PIECE(ABMX(1),U,2)=""
SET $PIECE(ABMX(1),U,2)="no primary DX"
+4 GOTO GPRC
+5 ;
CHKPOV ;
+1 SET ABM("X")=""
+2 SET ABMX(0)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMX(0),0)),U)
+3 IF ABMX(0)=""
QUIT
+4 ;Q:'$D(^ICD9(ABMX(0),0)) S ABM("X")=$E($P($$DX^ABMCVAPI(ABMX(0),""),U,4),1,28) ;abm*2.6*14 update API call
+5 ;abm*2.6*14 update API call
IF '$DATA(^ICD9(ABMX(0),0))
QUIT
SET ABM("X")=$EXTRACT($PIECE($$DX^ABMCVAPI(+ABMX(0),""),U,4),1,28)
+6 QUIT
+7 ;
GPRC ;
+1 SET ABM(0)=""
+2 FOR ABM=1:1
SET ABM(0)=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM(0)))
IF ABM(0)=""
QUIT
SET ABMX(0)=$ORDER(^(ABM(0),""))
DO CHKPRC
SET $PIECE(ABMX(ABM),U,3)=ABM("X")
+3 IF $PIECE(ABMX(1),U,3)=""
SET $PIECE(ABMX(1),U,3)="no procedures"
+4 GOTO PWRT
+5 ;
CHKPRC ;
+1 SET ABM("X")=""
+2 SET ABMX(0)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMX(0),0)),U)
+3 IF ABMX(0)=""
QUIT
+4 ;CSV-c
IF '$DATA(^ICD0(ABMX(0),0))
QUIT
SET ABM("X")=$EXTRACT($PIECE($$ICDOP^ABMCVAPI(ABMX(0),""),U,5),1,27)
+5 QUIT
+6 ;
PWRT ;
+1 SET ABM=0
+2 FOR
SET ABM=$ORDER(ABMX(ABM))
IF ABM=""
QUIT
+3 IF $Y>(IOSL-(8+ABM))
SET ABM("CONT")=""
DO HEAD^ABMDRSU1
IF $DATA(ABMP("QUIT"))
QUIT
DO HD^ABMDRSU1
+4 WRITE !!?4,"ICD Diagnosis",?34,"Procedure Narrative",?63,"Provider Class"
+5 WRITE !,?4,"----------------------------",?34,"---------------------------",?63,"----------------"
+6 SET ABM=0
+7 FOR
SET ABM=$ORDER(ABMX(ABM))
IF ABM=""
QUIT
DO WRT
IF $DATA(ABMP("QUIT"))
QUIT
+8 IF $DATA(ABMP("QUIT"))
GOTO XIT
+9 GOTO GINS
+10 ;
WRT ;
+1 WRITE !?4,$PIECE(ABMX(ABM),U,2),?34,$PIECE(ABMX(ABM),U,3),?63,$PIECE(ABMX(ABM),U)
+2 QUIT
+3 ;
GINS ;
+1 KILL ABMX
+2 SET ABM(0)=0
+3 FOR ABM=1:1
SET ABM(0)=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0)))
IF 'ABM(0)
QUIT
SET ABM("INSCO")=$PIECE(^(ABM(0),0),U)
DO CHKINS
SET ABMX(ABM)=ABM("X")
+4 GOTO IWRT
+5 ;
CHKINS ;
+1 SET ABM("X")=""
+2 IF '$DATA(^AUTNINS(ABM("INSCO"),0))
QUIT
SET ABM("X")=$EXTRACT($PIECE(^(0),U),1,30)
+3 ;
COV ;
+1 SET ABM("G")=0
SET ABM("C")=""
+2 FOR
SET ABM("G")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0),11,ABM("G")))
IF 'ABM("G")
QUIT
SET ABM("C")=$SELECT(ABM("C")]"":ABM("C")_";"_$PIECE(^AUTTPIC(ABM("G"),0),U),1:$PIECE(^AUTTPIC(ABM("G"),0),U))
+3 SET $PIECE(ABM("X"),U,2)=ABM("C")
+4 SET $PIECE(ABM("X"),U,4)=$SELECT($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0),0),U,3)="F":"FLAGGED",$PIECE(^(0),U,3)="U":"BILLED",$PIECE(^(0),U,3)="I":"ACTIVE",$PIECE(^(0),U,3)="C":"COMPLETED",1:"PENDING")
+5 QUIT
+6 ;
IWRT ;
+1 SET ABM=0
+2 FOR
SET ABM=$ORDER(ABMX(ABM))
IF ABM=""
QUIT
+3 IF $Y>(IOSL-(4+ABM))
SET ABM("CONT")=""
DO HEAD^ABMDRSU1
IF $DATA(ABMP("QUIT"))
QUIT
DO HD^ABMDRSU1
+4 WRITE !!,?4,"Insurance Company",?38,"Coverage Types",?68,"Status"
+5 WRITE !?4
FOR I=1:1:75
WRITE "-"
+6 SET ABM=0
+7 FOR
SET ABM=$ORDER(ABMX(ABM))
IF ABM=""
QUIT
DO IWRT1
IF $DATA(ABMP("QUIT"))
QUIT
+8 IF $DATA(ABMP("QUIT"))
GOTO XIT
+9 IF $Y'>(IOSL-10)
WRITE !!!,ABM("80E")
+10 KILL ABMX
+11 QUIT
+12 ;
IWRT1 ;
+1 WRITE !?4,$PIECE(ABMX(ABM),U,1),?40,$PIECE(ABMX(ABM),U,2),?42,$PIECE(ABMX(ABM),U,3),?68,$PIECE(ABMX(ABM),U,4)
+2 QUIT
+3 ;
XIT QUIT
