ABMDE0 ; IHS/ASDST/DMJ - Claim Summary Page ; 10 Nov 2009 2:48 PM
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009;Build 133
;
; IHS/ASDS/LSL - 08/13/2001 - V2.4 Patch 9 NOIS HQW-0798-100082
; If all insurers are unbillable - ask if delete claim
;
; IHS/SD/SDR - v2.5 p8 - Fix supplied by Carlene McIntyre for
; OmniCell link
;
; IHS/SD/SDR,TPF - v2.5 p8 - added code for pending status (12)
;
; IHS/SD/SDR - v2.5 p8 - task 57
; Added code for Rx changes (dt disc. and RTS)
;
; IHS/SD/SDR - v2.5 p8 - task 5
; Added code for CLIA number to populate on claims if none on
; claim and default is present
;
; IHS/SD/SDR - v2.5 p9 - per Adrian
; Only display meds check if claim status isn't Uneditable or
; Complete
;
; IHS/SD/SDR - v2.5 p11 - IM22787
; Modified so future term date for replacement insurer will work
;
; *********************************************************************
;
OPT K ABM,ABMV,ABME,ABMZ
G XIT:$D(ABMP("DDL")),CONT:$G(ABMP("OPT"))="V"
W !!?15,"...<< Processing, Claim Error Checks >>..."
S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
S ABMC("QUE")=2
S ABMC("E0")=""
D ERRIN^ABMDECK
D ^ABMDE1X
D TPICHECK^ABMDE1
N I F I=106,107,108,10,102,12,13,6,151,152,153,109 D
. Q:'$D(ABME(I))
. S ABMP("JUMP1")=0
K ABME,ABMC,ABMP("CHK"),ABMP("DDL")
G CONT:$P($G(ABMP("STATUS")),U)=1
D PCC
G:$G(ABMNOPCC) XIT
D ELIG
G:$G(ABMNOELG) XIT
S $P(ABMP("STATUS"),U)=1
D D2^ABMDE8X ;build array of Rxs from V Med file/23 multiple
;this checks to see if drugs are RTS or discontinued
S ABMRXIEN=0,ABMRXFLG=0
F S ABMRXIEN=$O(ABMMEDS(ABMRXIEN)) Q:+ABMRXIEN=0 D Q:ABMRXFLG=1
.I $P($G(ABMMEDS(ABMRXIEN)),U,3)'="",('$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,"B",ABMRXIEN))) S ABMRXFLG=1
.I $P($G(ABMMEDS(ABMRXIEN)),U,4)'="",('$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,"B",ABMRXIEN))) S ABMRXFLG=1
I ABMRXFLG=1 D PUTMEDS
D D2^ABMDE8X
;
CONT ; EP
D OPEN^ABMDTMS(+$G(ABMP("PDFN")),+$G(ABMP("CDFN"))) ;OmniCell call
D CLIACHK
D ^ABMDE0X
W $$EN^ABMVDF("IOF")
S ABMP("OPT")="VCFNJQ"
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="U"!($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="X") D
. S ABMP("OPT")="VNJQ"
. S ABMP("DFLT")="Q"
. S ABMP("VIEWMODE")=1
D DISP^ABMDE0A
W !
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="P" D
.W !
.W "Pending for "
.W $P($G(^ABMPSTAT($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,18),0)),U) ;status
.W " by "_$P($G(^VA(200,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,19),0)),U,2) ;new person inits
.W !
D SEL^ABMDEOPT
I "CFV"'[$E(Y) G XIT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
K ABM,ABMZ
I $E(X)="V" D G OPT
. D ^ABMDECK
. S ABMP("SCRN")=0
. K DUOUT,DTOUT,DIRUT,DIROUT
. S ABMP("OPT")="V"
I $E(X)="C"!($E(X)="A") D ^ABMDEOK G XIT:$D(ABMP("OVER")),OPT
I $E(X)="F" D S Y="Q" G XIT
.D EN^ABMSTAT($G(ABMP("CDFN")))
.S ABMP("SCRN")=0
.K DUOUT,DTOUT,DIRUT,DIROUT
.S ABMP("OPT")="V"
;
XIT ;
I $G(ABMP("JUMP1")) D
. S ABMP("SCRN")=1
. K ABMP("JUMP1")
K ABM,ABMV,ABME,ABMZ
Q
;
; *********************************************************************
ELIG ;EP - CHECK ELIGIBILITY
K ABMNOELG
W !!?8,"...<< Checking Eligibility Files for Potential Coverage >>...",!!
D ^ABMDE2E
N INSGOOD,INS
S (INSGOOD,INS)=0
F S INS=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,INS)) Q:'+INS D
. S:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,INS,0)),U,3)'="U" INSGOOD=1
I '+INSGOOD D
. D ^ABMDE0X
. D DISP^ABMDE0A
. W !?3,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
. W " CANNOT OPEN CLAIM - NO ELIGIBILITY FOUND FOR THIS PATIENT.",!
. D ENT2^ABMDECAN
. S Y="Q"
. S ABMNOELG=1
Q
PCC ;check pcc primary visit
K ABMNOPCC
Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,"AC","P"))
N I
S I=0
F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,"AC","P",I)) Q:'I D
.Q:$P($G(^AUPNVSIT(I,0)),"^",11)
.S ABMPRI=I
Q:$G(ABMPRI)
D ^ABMDE0X
D DISP^ABMDE0A
W !?3,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
W " THE PRIMARY PCC VISIT FOR THIS CLAIM HAS BEEN DELETED.",!
D ENT2^ABMDECAN
S Y="Q"
S ABMNOPCC=1
Q
PUTMEDS ;
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="C"!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="U") Q
W !!," * * * * * * M E D I C A T I O N A L E R T * * * * * *"
W !!
K DD,DO,DIE,DIC,DIR
S DIR("A")="DO YOU WISH TO INCLUDE THOSE ENTRIES ON PAGE 8D"
S DIR("A",1)="MEDICATIONS WITH A 'DATE DISCONTINUED' OR 'RETURN TO STOCK' ENTRY HAVE BEEN"
S DIR("A",2)="IDENTIFIED."
S DIR("A",3)=""
S DIR(0)="Y"
S DIR("B")="N"
D ^DIR K DIR
I Y=1 D
.S ABMRXFLG=1
.S ABMVIEN=0
.F S ABMVIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMVIEN)) Q:+ABMVIEN=0 D
..S ABMP("V0")=$G(^AUPNVSIT(ABMVIEN,0))
..D ^ABMDVST5 ;they want to include all meds on claim
K ABMMEDS,ABMRXFLG,ABMVIEN
Q
CLIACHK ;
;reference
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23)="" D
.K DIE,DA,DR
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".923////"_$P($G(^ABMDPARM(DUZ(2),1,4)),U,12)
.D ^DIE
;in-house
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22)="" D
.K DIE,DA,DR
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".922////"_$P($G(^ABMDPARM(DUZ(2),1,4)),U,11)
.D ^DIE
Q
ABMDE0 ; IHS/ASDST/DMJ - Claim Summary Page ; 10 Nov 2009 2:48 PM
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009;Build 133
+2 ;
+3 ; IHS/ASDS/LSL - 08/13/2001 - V2.4 Patch 9 NOIS HQW-0798-100082
+4 ; If all insurers are unbillable - ask if delete claim
+5 ;
+6 ; IHS/SD/SDR - v2.5 p8 - Fix supplied by Carlene McIntyre for
+7 ; OmniCell link
+8 ;
+9 ; IHS/SD/SDR,TPF - v2.5 p8 - added code for pending status (12)
+10 ;
+11 ; IHS/SD/SDR - v2.5 p8 - task 57
+12 ; Added code for Rx changes (dt disc. and RTS)
+13 ;
+14 ; IHS/SD/SDR - v2.5 p8 - task 5
+15 ; Added code for CLIA number to populate on claims if none on
+16 ; claim and default is present
+17 ;
+18 ; IHS/SD/SDR - v2.5 p9 - per Adrian
+19 ; Only display meds check if claim status isn't Uneditable or
+20 ; Complete
+21 ;
+22 ; IHS/SD/SDR - v2.5 p11 - IM22787
+23 ; Modified so future term date for replacement insurer will work
+24 ;
+25 ; *********************************************************************
+26 ;
OPT KILL ABM,ABMV,ABME,ABMZ
+1 IF $DATA(ABMP("DDL"))
GOTO XIT
IF $GET(ABMP("OPT"))="V"
GOTO CONT
+2 WRITE !!?15,"...<< Processing, Claim Error Checks >>..."
+3 SET ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
+4 SET ABMC("QUE")=2
+5 SET ABMC("E0")=""
+6 DO ERRIN^ABMDECK
+7 DO ^ABMDE1X
+8 DO TPICHECK^ABMDE1
+9 NEW I
FOR I=106,107,108,10,102,12,13,6,151,152,153,109
Begin DoDot:1
+10 IF '$DATA(ABME(I))
QUIT
+11 SET ABMP("JUMP1")=0
End DoDot:1
+12 KILL ABME,ABMC,ABMP("CHK"),ABMP("DDL")
+13 IF $PIECE($GET(ABMP("STATUS")),U)=1
GOTO CONT
+14 DO PCC
+15 IF $GET(ABMNOPCC)
GOTO XIT
+16 DO ELIG
+17 IF $GET(ABMNOELG)
GOTO XIT
+18 SET $PIECE(ABMP("STATUS"),U)=1
+19 ;build array of Rxs from V Med file/23 multiple
DO D2^ABMDE8X
+20 ;this checks to see if drugs are RTS or discontinued
+21 SET ABMRXIEN=0
SET ABMRXFLG=0
+22 FOR
SET ABMRXIEN=$ORDER(ABMMEDS(ABMRXIEN))
IF +ABMRXIEN=0
QUIT
Begin DoDot:1
+23 IF $PIECE($GET(ABMMEDS(ABMRXIEN)),U,3)'=""
IF ('$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,"B",ABMRXIEN)))
SET ABMRXFLG=1
+24 IF $PIECE($GET(ABMMEDS(ABMRXIEN)),U,4)'=""
IF ('$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,"B",ABMRXIEN)))
SET ABMRXFLG=1
End DoDot:1
IF ABMRXFLG=1
QUIT
+25 IF ABMRXFLG=1
DO PUTMEDS
+26 DO D2^ABMDE8X
+27 ;
CONT ; EP
+1 ;OmniCell call
DO OPEN^ABMDTMS(+$GET(ABMP("PDFN")),+$GET(ABMP("CDFN")))
+2 DO CLIACHK
+3 DO ^ABMDE0X
+4 WRITE $$EN^ABMVDF("IOF")
+5 SET ABMP("OPT")="VCFNJQ"
+6 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="U"!($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="X")
Begin DoDot:1
+7 SET ABMP("OPT")="VNJQ"
+8 SET ABMP("DFLT")="Q"
+9 SET ABMP("VIEWMODE")=1
End DoDot:1
+10 DO DISP^ABMDE0A
+11 WRITE !
+12 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="P"
Begin DoDot:1
+13 WRITE !
+14 WRITE "Pending for "
+15 ;status
WRITE $PIECE($GET(^ABMPSTAT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,18),0)),U)
+16 ;new person inits
WRITE " by "_$PIECE($GET(^VA(200,$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,19),0)),U,2)
+17 WRITE !
End DoDot:1
+18 DO SEL^ABMDEOPT
+19 IF "CFV"'[$EXTRACT(Y)
GOTO XIT
+20 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+21 KILL ABM,ABMZ
+22 IF $EXTRACT(X)="V"
Begin DoDot:1
+23 DO ^ABMDECK
+24 SET ABMP("SCRN")=0
+25 KILL DUOUT,DTOUT,DIRUT,DIROUT
+26 SET ABMP("OPT")="V"
End DoDot:1
GOTO OPT
+27 IF $EXTRACT(X)="C"!($EXTRACT(X)="A")
DO ^ABMDEOK
IF $DATA(ABMP("OVER"))
GOTO XIT
GOTO OPT
+28 IF $EXTRACT(X)="F"
Begin DoDot:1
+29 DO EN^ABMSTAT($GET(ABMP("CDFN")))
+30 SET ABMP("SCRN")=0
+31 KILL DUOUT,DTOUT,DIRUT,DIROUT
+32 SET ABMP("OPT")="V"
End DoDot:1
SET Y="Q"
GOTO XIT
+33 ;
XIT ;
+1 IF $GET(ABMP("JUMP1"))
Begin DoDot:1
+2 SET ABMP("SCRN")=1
+3 KILL ABMP("JUMP1")
End DoDot:1
+4 KILL ABM,ABMV,ABME,ABMZ
+5 QUIT
+6 ;
+7 ; *********************************************************************
ELIG ;EP - CHECK ELIGIBILITY
+1 KILL ABMNOELG
+2 WRITE !!?8,"...<< Checking Eligibility Files for Potential Coverage >>...",!!
+3 DO ^ABMDE2E
+4 NEW INSGOOD,INS
+5 SET (INSGOOD,INS)=0
+6 FOR
SET INS=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,INS))
IF '+INS
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,INS,0)),U,3)'="U"
SET INSGOOD=1
End DoDot:1
+8 IF '+INSGOOD
Begin DoDot:1
+9 DO ^ABMDE0X
+10 DO DISP^ABMDE0A
+11 WRITE !?3,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
+12 WRITE " CANNOT OPEN CLAIM - NO ELIGIBILITY FOUND FOR THIS PATIENT.",!
+13 DO ENT2^ABMDECAN
+14 SET Y="Q"
+15 SET ABMNOELG=1
End DoDot:1
+16 QUIT
PCC ;check pcc primary visit
+1 KILL ABMNOPCC
+2 IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,"AC","P"))
QUIT
+3 NEW I
+4 SET I=0
+5 FOR
SET I=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,"AC","P",I))
IF 'I
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUPNVSIT(I,0)),"^",11)
QUIT
+7 SET ABMPRI=I
End DoDot:1
+8 IF $GET(ABMPRI)
QUIT
+9 DO ^ABMDE0X
+10 DO DISP^ABMDE0A
+11 WRITE !?3,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
+12 WRITE " THE PRIMARY PCC VISIT FOR THIS CLAIM HAS BEEN DELETED.",!
+13 DO ENT2^ABMDECAN
+14 SET Y="Q"
+15 SET ABMNOPCC=1
+16 QUIT
PUTMEDS ;
+1 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="C"!($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="U")
QUIT
+2 WRITE !!," * * * * * * M E D I C A T I O N A L E R T * * * * * *"
+3 WRITE !!
+4 KILL DD,DO,DIE,DIC,DIR
+5 SET DIR("A")="DO YOU WISH TO INCLUDE THOSE ENTRIES ON PAGE 8D"
+6 SET DIR("A",1)="MEDICATIONS WITH A 'DATE DISCONTINUED' OR 'RETURN TO STOCK' ENTRY HAVE BEEN"
+7 SET DIR("A",2)="IDENTIFIED."
+8 SET DIR("A",3)=""
+9 SET DIR(0)="Y"
+10 SET DIR("B")="N"
+11 DO ^DIR
KILL DIR
+12 IF Y=1
Begin DoDot:1
+13 SET ABMRXFLG=1
+14 SET ABMVIEN=0
+15 FOR
SET ABMVIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMVIEN))
IF +ABMVIEN=0
QUIT
Begin DoDot:2
+16 SET ABMP("V0")=$GET(^AUPNVSIT(ABMVIEN,0))
+17 ;they want to include all meds on claim
DO ^ABMDVST5
End DoDot:2
End DoDot:1
+18 KILL ABMMEDS,ABMRXFLG,ABMVIEN
+19 QUIT
CLIACHK ;
+1 ;reference
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23)=""
Begin DoDot:1
+3 KILL DIE,DA,DR
+4 SET DIE="^ABMDCLM(DUZ(2),"
+5 SET DA=ABMP("CDFN")
+6 SET DR=".923////"_$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,12)
+7 DO ^DIE
End DoDot:1
+8 ;in-house
+9 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22)=""
Begin DoDot:1
+10 KILL DIE,DA,DR
+11 SET DIE="^ABMDCLM(DUZ(2),"
+12 SET DA=ABMP("CDFN")
+13 SET DR=".922////"_$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,11)
+14 DO ^DIE
End DoDot:1
+15 QUIT
