ABMDE2A ; IHS/SD/SDR - PAGE 2 - INSURER VIEW OPTION ;
;;2.6;IHS 3P BILLING SYSTEM;**21,26,27**;NOV 12, 2009;Build 486
;
;IHS/SD/SDR V2.5 P2 4/17/02 - NOIS NEA-0401-180046 - Modified to include coverage
; type in claim editor for the insurer view portion
;
;IHS/SD/SDR v2.5 p8 task 8 - Added code to look for replacement insurer
;IHS/SD/SDR v2.5 p9 IM18938 - Added RATE CODE to display
;IHS/SD/SDR v2.5 p12 UFMS - Added display of TIN
;
;IHS/SD/SDR 2.6*21 VMBP RQMT_109 - Updated View option for VAMB Eligible data
;IHS/SD/SDR 2.6*26 CR9264 Updated Page 2 View to for MBI with default to HICN for Medicare
;IHS/SD/SDR 2.6*27 CR10170 Fixed so insurer info and errors display correctly when replacement insurer is being used
;
; *********************************************************************
;
V1 ; view
I $E(Y,2)>0&($E(Y,2)<(ABMZ("NUM")+1)) D G V2
.S Y=$E(Y,2)
I ABMZ("NUM")=1 D G V2
.S Y=1
K DIR
S DIR(0)="NO^1:"_ABMZ("NUM")_":0"
S DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to View"
S DIR("A")="Sequence Number to VIEW"
D ^DIR
K DIR
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(+Y'>0)
;
V2 ;
S Y=$P(ABMZ(+Y),U,3)
S ABM("XIEN")=+Y
S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
;S Y=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U,11)'="":$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U,11),1:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U)) ;abm*2.6*27 IHS/SD/SDR CR10170
S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U) ;abm*2.6*27 IHS/SD/SDR CR10170
D SEL^ABMDE2X
S ABMZ("TITL")="INSURER - VIEW OPTION"
D SUM^ABMDE1
S ABMV="",$P(ABMV,"-",80)=""
;W !,"Insurer..: ",$E($P($P(ABMV("X1"),U),";",2),1,30) ;abm*2.6*27 IHS/SD/SDR CR10170
S ABMT("INS")=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+ABM("XIEN"),0),U,11)'="":$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U,11),1:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U)) ;abm*2.6*27 IHS/SD/SDR CR10170
W !,"Insurer..: ",$E($P($G(^AUTNINS(ABMT("INS"),0)),U),1,30) ;abm*2.6*27 IHS/SD/SDR CR10170
W ?45,"Phone....: ",$P(ABMV("X1"),U,2)
W !,"Prov. No.: ",$P(ABMV("X1"),U,7)
W ?45,"Contact..: ",$E($P(ABMV("X1"),U,3),1,24)
W !,"TIN......: ",$P($G(^AUTNINS($P(ABMV("X1"),";"),0)),U,11)
S ABMPRI=0,ABMPFLG=0
F S ABMPRI=$O(ABML(ABMPRI)) Q:+ABMPRI=0!($G(ABMPFLG)=1)!($G(ABMPFLG)=2) D Q:($G(ABMPFLG)=1)!($G(ABMPFLG)=2)
.I $G(ABML(ABMPRI,Y))'="",(ABMPRI>97) S ABMPFLG=1
.I $G(ABML(ABMPRI,Y))'="" S ABMPFLG=2
I $G(ABMPFLG)=1 W !,"*UNBILLABLE* for reason ",$P($G(^ABMDCS($P($G(ABML(ABMPRI,Y)),U,6),0)),U)
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0)),U,11)'="" D
.W !?5,"**This insurer replaces "
.W $P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0)),U),0)),U)
.W " for this claim only!"
W !,ABMV
;W !,$S($P($P(ABMV("X1"),U),";",2)="MEDICARE":"HIC Number.......: ",1:"Policy Number....: "),$P(ABMV("X1"),U,4) ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
;start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
;W !,$S($P($P(ABMV("X1"),U),";",2)="MEDICARE":"HIC Number....: ",$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMV("X1"),".211","I"),1,"I")="V":"VMBP Enrollment Number..: ",1:"Policy Number...: "),$P(ABMV("X1"),U,4) ;abm*2.6*26 CR9264
;start new abm*2.6*26 IHS/SD/SDR CR9264
W !
W $S($P($P(ABMV("X1"),U),";",2)="MEDICARE":"Medicare Number....: ",$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMV("X1"),".211","I"),1,"I")="V":"VMBP Enrollment Number..: ",1:"Policy Number...: ")
W $P(ABMV("X1"),U,4)
;end new abm*2.6*26 IHS/SD/SDR CR9264
;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
I $P($G(ABMV("X1")),U,13)'="" W ?45,"Rate Code.......:",$P($G(ABMV("X1")),U,13)
I ABMV("X2")="" G ERR
;start old code abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
;W !,"Group Name.......: ",$P(ABMV("X3"),U,6)
;W ?45,"Group Number....: ",$P(ABMV("X3"),U,7)
;end old start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMV("X1"),".211","I"),1,"I")'="V" D
.W !,"Group Name.......: ",$P(ABMV("X3"),U,6)
.W ?45,"Group Number....: ",$P(ABMV("X3"),U,7)
;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
S ABMCOV=""
F S ABMCOV=$O(ABMP("COV",ABMCOV)) Q:ABMCOV="" D
.S ABMEDT=$P(ABMP("COV",ABMCOV),U)
.S ABMEEDT=$P(ABMP("COV",ABMCOV),U,2)
.W !,?3,"Elig dt: ",$$SDT^ABMDUTL(ABMEDT),?30,"Elig end dt: ",$$SDT^ABMDUTL(ABMEEDT)
.W ?55,"Coverage: ",$E(ABMCOV,1,24)
W !,ABMV
W !,"Policy Holder.: ",$P($P(ABMV("X2"),U),";",2)
W ?48,"Relationship..: ",$P($P(ABMV("X2"),U,2),";",2)
W !?16,$P(ABMV("X2"),U,3)
W ?48,"Home Phone....: ",$P(ABMV("X2"),U,5)
W !?16,$P(ABMV("X2"),U,4)
W !!?3,"Employer...: ",$P(ABMV("X3"),U)
W ?48,"Empl. Status..: ",$P($P(ABMV("X3"),U,5),";",2)
W !?16,$P(ABMV("X3"),U,2)
W ?48,"Work Phone....: ",$P(ABMV("X3"),U,4)
W !?16,$P(ABMV("X3"),U,3)
;
ERR ;
D ^ABMDERR
W !
S ABM("Y")=+Y
;
XIT ;
K ABM
Q
ABMDE2A ; IHS/SD/SDR - PAGE 2 - INSURER VIEW OPTION ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**21,26,27**;NOV 12, 2009;Build 486
+2 ;
+3 ;IHS/SD/SDR V2.5 P2 4/17/02 - NOIS NEA-0401-180046 - Modified to include coverage
+4 ; type in claim editor for the insurer view portion
+5 ;
+6 ;IHS/SD/SDR v2.5 p8 task 8 - Added code to look for replacement insurer
+7 ;IHS/SD/SDR v2.5 p9 IM18938 - Added RATE CODE to display
+8 ;IHS/SD/SDR v2.5 p12 UFMS - Added display of TIN
+9 ;
+10 ;IHS/SD/SDR 2.6*21 VMBP RQMT_109 - Updated View option for VAMB Eligible data
+11 ;IHS/SD/SDR 2.6*26 CR9264 Updated Page 2 View to for MBI with default to HICN for Medicare
+12 ;IHS/SD/SDR 2.6*27 CR10170 Fixed so insurer info and errors display correctly when replacement insurer is being used
+13 ;
+14 ; *********************************************************************
+15 ;
V1 ; view
+1 IF $EXTRACT(Y,2)>0&($EXTRACT(Y,2)<(ABMZ("NUM")+1))
Begin DoDot:1
+2 SET Y=$EXTRACT(Y,2)
End DoDot:1
GOTO V2
+3 IF ABMZ("NUM")=1
Begin DoDot:1
+4 SET Y=1
End DoDot:1
GOTO V2
+5 KILL DIR
+6 SET DIR(0)="NO^1:"_ABMZ("NUM")_":0"
+7 SET DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to View"
+8 SET DIR("A")="Sequence Number to VIEW"
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(+Y'>0)
GOTO XIT
+12 ;
V2 ;
+1 SET Y=$PIECE(ABMZ(+Y),U,3)
+2 SET ABM("XIEN")=+Y
+3 SET ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
+4 ;S Y=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U,11)'="":$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U,11),1:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U)) ;abm*2.6*27 IHS/SD/SDR CR10170
+5 ;abm*2.6*27 IHS/SD/SDR CR10170
SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+Y,0),U)
+6 DO SEL^ABMDE2X
+7 SET ABMZ("TITL")="INSURER - VIEW OPTION"
+8 DO SUM^ABMDE1
+9 SET ABMV=""
SET $PIECE(ABMV,"-",80)=""
+10 ;W !,"Insurer..: ",$E($P($P(ABMV("X1"),U),";",2),1,30) ;abm*2.6*27 IHS/SD/SDR CR10170
+11 ;abm*2.6*27 IHS/SD/SDR CR10170
SET ABMT("INS")=$SELECT($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,+ABM("XIEN"),0),U,11)'="":$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U,11),1:$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U))
+12 ;abm*2.6*27 IHS/SD/SDR CR10170
WRITE !,"Insurer..: ",$EXTRACT($PIECE($GET(^AUTNINS(ABMT("INS"),0)),U),1,30)
+13 WRITE ?45,"Phone....: ",$PIECE(ABMV("X1"),U,2)
+14 WRITE !,"Prov. No.: ",$PIECE(ABMV("X1"),U,7)
+15 WRITE ?45,"Contact..: ",$EXTRACT($PIECE(ABMV("X1"),U,3),1,24)
+16 WRITE !,"TIN......: ",$PIECE($GET(^AUTNINS($PIECE(ABMV("X1"),";"),0)),U,11)
+17 SET ABMPRI=0
SET ABMPFLG=0
+18 FOR
SET ABMPRI=$ORDER(ABML(ABMPRI))
IF +ABMPRI=0!($GET(ABMPFLG)=1)!($GET(ABMPFLG)=2)
QUIT
Begin DoDot:1
+19 IF $GET(ABML(ABMPRI,Y))'=""
IF (ABMPRI>97)
SET ABMPFLG=1
+20 IF $GET(ABML(ABMPRI,Y))'=""
SET ABMPFLG=2
End DoDot:1
IF ($GET(ABMPFLG)=1)!($GET(ABMPFLG)=2)
QUIT
+21 IF $GET(ABMPFLG)=1
WRITE !,"*UNBILLABLE* for reason ",$PIECE($GET(^ABMDCS($PIECE($GET(ABML(ABMPRI,Y)),U,6),0)),U)
+22 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0)),U,11)'=""
Begin DoDot:1
+23 WRITE !?5,"**This insurer replaces "
+24 WRITE $PIECE($GET(^AUTNINS($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0)),U),0)),U)
+25 WRITE " for this claim only!"
End DoDot:1
+26 WRITE !,ABMV
+27 ;W !,$S($P($P(ABMV("X1"),U),";",2)="MEDICARE":"HIC Number.......: ",1:"Policy Number....: "),$P(ABMV("X1"),U,4) ;abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
+28 ;start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
+29 ;W !,$S($P($P(ABMV("X1"),U),";",2)="MEDICARE":"HIC Number....: ",$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMV("X1"),".211","I"),1,"I")="V":"VMBP Enrollment Number..: ",1:"Policy Number...: "),$P(ABMV("X1"),U,4) ;abm*2.6*26 CR9264
+30 ;start new abm*2.6*26 IHS/SD/SDR CR9264
+31 WRITE !
+32 WRITE $SELECT($PIECE($PIECE(ABMV("X1"),U),";",2)="MEDICARE":"Medicare Number....: ",$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMV("X1"),".211","I"),1,"I")="V":"VMBP Enrollment Number..: ",1:"Policy Number...: ")
+33 WRITE $PIECE(ABMV("X1"),U,4)
+34 ;end new abm*2.6*26 IHS/SD/SDR CR9264
+35 ;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
+36 IF $PIECE($GET(ABMV("X1")),U,13)'=""
WRITE ?45,"Rate Code.......:",$PIECE($GET(ABMV("X1")),U,13)
+37 IF ABMV("X2")=""
GOTO ERR
+38 ;start old code abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
+39 ;W !,"Group Name.......: ",$P(ABMV("X3"),U,6)
+40 ;W ?45,"Group Number....: ",$P(ABMV("X3"),U,7)
+41 ;end old start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
+42 IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMV("X1"),".211","I"),1,"I")'="V"
Begin DoDot:1
+43 WRITE !,"Group Name.......: ",$PIECE(ABMV("X3"),U,6)
+44 WRITE ?45,"Group Number....: ",$PIECE(ABMV("X3"),U,7)
End DoDot:1
+45 ;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
+46 SET ABMCOV=""
+47 FOR
SET ABMCOV=$ORDER(ABMP("COV",ABMCOV))
IF ABMCOV=""
QUIT
Begin DoDot:1
+48 SET ABMEDT=$PIECE(ABMP("COV",ABMCOV),U)
+49 SET ABMEEDT=$PIECE(ABMP("COV",ABMCOV),U,2)
+50 WRITE !,?3,"Elig dt: ",$$SDT^ABMDUTL(ABMEDT),?30,"Elig end dt: ",$$SDT^ABMDUTL(ABMEEDT)
+51 WRITE ?55,"Coverage: ",$EXTRACT(ABMCOV,1,24)
End DoDot:1
+52 WRITE !,ABMV
+53 WRITE !,"Policy Holder.: ",$PIECE($PIECE(ABMV("X2"),U),";",2)
+54 WRITE ?48,"Relationship..: ",$PIECE($PIECE(ABMV("X2"),U,2),";",2)
+55 WRITE !?16,$PIECE(ABMV("X2"),U,3)
+56 WRITE ?48,"Home Phone....: ",$PIECE(ABMV("X2"),U,5)
+57 WRITE !?16,$PIECE(ABMV("X2"),U,4)
+58 WRITE !!?3,"Employer...: ",$PIECE(ABMV("X3"),U)
+59 WRITE ?48,"Empl. Status..: ",$PIECE($PIECE(ABMV("X3"),U,5),";",2)
+60 WRITE !?16,$PIECE(ABMV("X3"),U,2)
+61 WRITE ?48,"Work Phone....: ",$PIECE(ABMV("X3"),U,4)
+62 WRITE !?16,$PIECE(ABMV("X3"),U,3)
+63 ;
ERR ;
+1 DO ^ABMDERR
+2 WRITE !
+3 SET ABM("Y")=+Y
+4 ;
XIT ;
+1 KILL ABM
+2 QUIT
