IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 05-MAY-2015
;;2.0;INTEGRATED BILLING;**28,56,549**; 21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
% G EN^IBCNSM
;
VP ; -- View Patient Policy Info
D FULL^VALM1
N I,J,IBXX,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D ;W !,"Entry ",X,"Selected" D
.S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.Q:IBPPOL=""
.D EN^VALM("IBCNS EXPANDED POLICY")
.Q
I '$G(IBFASTXT) D BLD^IBCNSM
S VALMBCK="R" Q
;
AB ; -- Edit Annual Benefits
D FULL^VALM1
;
; IB*2.0*549 - Added Security Key check
I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
. W !!,*7,"Sorry, but you do not have the required privileges to edit Annual Benefits."
. K DIR
. D PAUSE^VALM1
. S VALMBCK="R"
;
N I,J,IBXX,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.Q:IBPPOL=""
.S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
.D FULL^VALM1
.D EN^VALM("IBCNS ANNUAL BENEFITS")
.Q
S VALMBCK="R"
Q
;
UP ; -- Print new, not verified insurance
;
N I,J,IBXX,IBCNS,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) W !,IBXX,! H 2 Q:'IBXX D
.S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.Q:IBPPOL=""
.S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
.S INSCO=^DIC(36,IBCNS,0)
.W !!,$P(INSCO,"^"),!! H 2
.W !!,$P(IBPPOL,"^",4),!! H 2
.Q
D FULL^VALM1
W !!,"REPORT OF NEW NOT VERIFIED INSURANCE",!! H 2
S VALMBCK="R" Q
;
PC ; -- Print Patient Insurance info
;N IBLINE,IBCY,IBWP
N IBWP
;
PCWP ; -- Print Insurance Coverage, Worksheet
;
N I,J,IBXX,IBLINE,IBCY,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.Q:IBPPOL=""
.S IBCPOL=$P(IBPPOL,"^",22)
.S IBLINE=$S($G(IBWP):1,1:0)
.S IBCY=$S($G(IBWP):0,1:1)
.D WPPC^IBCNSM5
.Q
S VALMBCK="R" Q
;
WP ; -- Print Worksheet
N IBWP
S IBWP=1
D PCWP
S VALMBCK="R" Q
;
DP ; -- Delete insurance policy
D FULL^VALM1
I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D SORRY^IBTRE1 G DPQ
N I,J,IBXX,DIR,DIRUT,IBBCNT,BLD,IBCOVP,IBFNOPOL,VALMY
D EN^VALM2($G(XQORNOD(0)))
S IBCOVP=$P($G(^DPT(DFN,.31)),"^",11)
; if no policies, set ibfnopol flag to prevent call to pause^valm1
; at label dpq
I '$D(VALMY) S IBFNOPOL=1
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
.S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.; do some error checking here
.I $$DELP^IBCNSU(DFN,$P(IBPPOL,"^",5)) D Q
..W !,"You can't delete this policy, there are bills associated with it."
..W ! S J=0 F S J=$O(^DGCR(399,"AE",DFN,$P(IBPPOL,"^",5),J)) Q:'J I $P(^DGCR(399,J,"S"),"^",17)="" W $P(^DGCR(399,J,0),"^")_" " S IBBCNT=$G(IBBCNT)+1 W:'(IBBCNT#8) !
..K IBBCNT
..Q
.;
.; - warn if there are associated Insurance reviews
.I $$IR^IBCNSJ21(DFN,+$P(IBPPOL,"^",4)) W !,*7,"Please note that there are Insurance Reviews associated with this policy!!",!
.;
.S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete policy #"_IBXX
.D ^DIR K DIR I Y'=1 W !,"Policy #",IBXX," not Deleted!" Q
.S IBCDFN=$P(IBPPOL,"^",4)
.D DP1
.Q
DPQ D COVERED^IBCNSM31(DFN,$G(IBCOVP))
I '$G(IBFNOPOL) D PAUSE^VALM1
I $G(BLD) D BLD^IBCNSM
S VALMBCK="R" Q
;
DP1 ; -- actual deletion
N DA,DIC,DIK,IBJJ,IBJJJ,IBBU,IBPLAN,IBCPOLD
S IBPLAN=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18),IBCPOLD=$G(^IBA(355.3,+IBPLAN,0))
;
; -- delete riders
S IBJJ=0 F S IBJJ=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBJJ)) Q:'IBJJ D
.S IBJJJ=0 F S IBJJJ=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBJJ,IBJJJ)) Q:'IBJJJ S DA=IBJJJ,DIK="^IBA(355.7,",DIDEL=355.7 D ^DIK
;
; -- delete benefits used
I IBPLAN D BU^IBCNSJ21 S IBJJ="" F S IBJJ=$O(IBBU(IBJJ)) Q:IBJJ="" D DBU^IBCNSJ(IBBU(IBJJ))
;
; -- remove pointers from Insurance reviews
S IBJJ=0 F S IBJJ=$O(^IBT(356.2,"D",DFN,IBJJ)) Q:'IBJJ I $P($G(^IBT(356.2,IBJJ,1)),"^",5)=IBCDFN S $P(^(1),"^",5)=""
;
; -- if individual policy, and is right patient, delete HIP
S BLD=1
I '$P(IBCPOLD,"^",2),DFN=$P(IBCPOLD,"^",10) D DEL^IBCNSJ(IBPLAN)
;
; -- delete entry in patient file
S DA=IBCDFN,DA(1)=DFN,DIK="^DPT("_DFN_",.312," D ^DIK
W:$G(IBXX) !,"Entry ",$G(IBXX)," Deleted"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSM1 4529 printed Sep 02, 2024@19:02:38 Page 2
IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 05-MAY-2015
+1 ;;2.0;INTEGRATED BILLING;**28,56,549**; 21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
% GOTO EN^IBCNSM
+1 ;
VP ; -- View Patient Policy Info
+1 DO FULL^VALM1
+2 NEW I,J,IBXX,VALMY
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 ;W !,"Entry ",X,"Selected" D
IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+6 if IBPPOL=""
QUIT
+7 DO EN^VALM("IBCNS EXPANDED POLICY")
+8 QUIT
End DoDot:1
+9 IF '$GET(IBFASTXT)
DO BLD^IBCNSM
+10 SET VALMBCK="R"
QUIT
+11 ;
AB ; -- Edit Annual Benefits
+1 DO FULL^VALM1
+2 ;
+3 ; IB*2.0*549 - Added Security Key check
+4 IF '$DATA(^XUSEC("IB GROUP PLAN EDIT",DUZ))
Begin DoDot:1
+5 WRITE !!,*7,"Sorry, but you do not have the required privileges to edit Annual Benefits."
+6 KILL DIR
+7 DO PAUSE^VALM1
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 ;
+10 NEW I,J,IBXX,VALMY
+11 DO EN^VALM2($GET(XQORNOD(0)))
+12 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+13 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+14 if IBPPOL=""
QUIT
+15 SET IBCNS=$PIECE(IBPPOL,"^",5)
SET IBCPOL=$PIECE(IBPPOL,"^",22)
+16 DO FULL^VALM1
+17 DO EN^VALM("IBCNS ANNUAL BENEFITS")
+18 QUIT
End DoDot:1
+19 SET VALMBCK="R"
+20 QUIT
+21 ;
UP ; -- Print new, not verified insurance
+1 ;
+2 NEW I,J,IBXX,IBCNS,VALMY
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
WRITE !,IBXX,!
HANG 2
if 'IBXX
QUIT
Begin DoDot:1
+5 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+6 if IBPPOL=""
QUIT
+7 SET IBCNS=$PIECE(IBPPOL,"^",5)
SET IBCPOL=$PIECE(IBPPOL,"^",22)
+8 SET INSCO=^DIC(36,IBCNS,0)
+9 WRITE !!,$PIECE(INSCO,"^"),!!
HANG 2
+10 WRITE !!,$PIECE(IBPPOL,"^",4),!!
HANG 2
+11 QUIT
End DoDot:1
+12 DO FULL^VALM1
+13 WRITE !!,"REPORT OF NEW NOT VERIFIED INSURANCE",!!
HANG 2
+14 SET VALMBCK="R"
QUIT
+15 ;
PC ; -- Print Patient Insurance info
+1 ;N IBLINE,IBCY,IBWP
+2 NEW IBWP
+3 ;
PCWP ; -- Print Insurance Coverage, Worksheet
+1 ;
+2 NEW I,J,IBXX,IBLINE,IBCY,VALMY
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+6 if IBPPOL=""
QUIT
+7 SET IBCPOL=$PIECE(IBPPOL,"^",22)
+8 SET IBLINE=$SELECT($GET(IBWP):1,1:0)
+9 SET IBCY=$SELECT($GET(IBWP):0,1:1)
+10 DO WPPC^IBCNSM5
+11 QUIT
End DoDot:1
+12 SET VALMBCK="R"
QUIT
+13 ;
WP ; -- Print Worksheet
+1 NEW IBWP
+2 SET IBWP=1
+3 DO PCWP
+4 SET VALMBCK="R"
QUIT
+5 ;
DP ; -- Delete insurance policy
+1 DO FULL^VALM1
+2 IF '$DATA(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))
DO SORRY^IBTRE1
GOTO DPQ
+3 NEW I,J,IBXX,DIR,DIRUT,IBBCNT,BLD,IBCOVP,IBFNOPOL,VALMY
+4 DO EN^VALM2($GET(XQORNOD(0)))
+5 SET IBCOVP=$PIECE($GET(^DPT(DFN,.31)),"^",11)
+6 ; if no policies, set ibfnopol flag to prevent call to pause^valm1
+7 ; at label dpq
+8 IF '$DATA(VALMY)
SET IBFNOPOL=1
+9 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX!$DATA(DIRUT)
QUIT
Begin DoDot:1
+10 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+11 ; do some error checking here
+12 IF $$DELP^IBCNSU(DFN,$PIECE(IBPPOL,"^",5))
Begin DoDot:2
+13 WRITE !,"You can't delete this policy, there are bills associated with it."
+14 WRITE !
SET J=0
FOR
SET J=$ORDER(^DGCR(399,"AE",DFN,$PIECE(IBPPOL,"^",5),J))
if 'J
QUIT
IF $PIECE(^DGCR(399,J,"S"),"^",17)=""
WRITE $PIECE(^DGCR(399,J,0),"^")_" "
SET IBBCNT=$GET(IBBCNT)+1
if '(IBBCNT#8)
WRITE !
+15 KILL IBBCNT
+16 QUIT
End DoDot:2
QUIT
+17 ;
+18 ; - warn if there are associated Insurance reviews
+19 IF $$IR^IBCNSJ21(DFN,+$PIECE(IBPPOL,"^",4))
WRITE !,*7,"Please note that there are Insurance Reviews associated with this policy!!",!
+20 ;
+21 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are You Sure you want to delete policy #"_IBXX
+22 DO ^DIR
KILL DIR
IF Y'=1
WRITE !,"Policy #",IBXX," not Deleted!"
QUIT
+23 SET IBCDFN=$PIECE(IBPPOL,"^",4)
+24 DO DP1
+25 QUIT
End DoDot:1
DPQ DO COVERED^IBCNSM31(DFN,$GET(IBCOVP))
+1 IF '$GET(IBFNOPOL)
DO PAUSE^VALM1
+2 IF $GET(BLD)
DO BLD^IBCNSM
+3 SET VALMBCK="R"
QUIT
+4 ;
DP1 ; -- actual deletion
+1 NEW DA,DIC,DIK,IBJJ,IBJJJ,IBBU,IBPLAN,IBCPOLD
+2 SET IBPLAN=$PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),"^",18)
SET IBCPOLD=$GET(^IBA(355.3,+IBPLAN,0))
+3 ;
+4 ; -- delete riders
+5 SET IBJJ=0
FOR
SET IBJJ=$ORDER(^IBA(355.7,"APP",DFN,IBCDFN,IBJJ))
if 'IBJJ
QUIT
Begin DoDot:1
+6 SET IBJJJ=0
FOR
SET IBJJJ=$ORDER(^IBA(355.7,"APP",DFN,IBCDFN,IBJJ,IBJJJ))
if 'IBJJJ
QUIT
SET DA=IBJJJ
SET DIK="^IBA(355.7,"
SET DIDEL=355.7
DO ^DIK
End DoDot:1
+7 ;
+8 ; -- delete benefits used
+9 IF IBPLAN
DO BU^IBCNSJ21
SET IBJJ=""
FOR
SET IBJJ=$ORDER(IBBU(IBJJ))
if IBJJ=""
QUIT
DO DBU^IBCNSJ(IBBU(IBJJ))
+10 ;
+11 ; -- remove pointers from Insurance reviews
+12 SET IBJJ=0
FOR
SET IBJJ=$ORDER(^IBT(356.2,"D",DFN,IBJJ))
if 'IBJJ
QUIT
IF $PIECE($GET(^IBT(356.2,IBJJ,1)),"^",5)=IBCDFN
SET $PIECE(^(1),"^",5)=""
+13 ;
+14 ; -- if individual policy, and is right patient, delete HIP
+15 SET BLD=1
+16 IF '$PIECE(IBCPOLD,"^",2)
IF DFN=$PIECE(IBCPOLD,"^",10)
DO DEL^IBCNSJ(IBPLAN)
+17 ;
+18 ; -- delete entry in patient file
+19 SET DA=IBCDFN
SET DA(1)=DFN
SET DIK="^DPT("_DFN_",.312,"
DO ^DIK
+20 if $GET(IBXX)
WRITE !,"Entry ",$GET(IBXX)," Deleted"
+21 QUIT
