IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 22-OCT-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, 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
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,VALMY
D EN^VALM2($G(XQORNOD(0)))
S IBCOVP=$P($G(^DPT(DFN,.31)),"^",11)
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
.;
.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))
D PAUSE^VALM1,BLD^IBCNSM:$G(BLD)
S VALMBCK="R" Q
;
DP1 ; -- actual deletion
N DA,DIC,DIK
;
; -- if individual policy, and is right patient, delete HIP
S BLD=1
S IBCPOL=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18),IBCPOLD=$G(^IBA(355.3,+IBCPOL,0))
I '$P(IBCPOLD,"^",2),DFN=$P(IBCPOLD,"^",10) S DA=IBCPOL,DIK="^IBA(355.3," D ^DIK K DA,DIC,DIK
;
; -- 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
IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 22-OCT-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, 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 NEW I,J,IBXX,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 IBCNS=$PIECE(IBPPOL,"^",5)
SET IBCPOL=$PIECE(IBPPOL,"^",22)
+8 DO FULL^VALM1
+9 DO EN^VALM("IBCNS ANNUAL BENEFITS")
+10 QUIT
End DoDot:1
+11 SET VALMBCK="R"
QUIT
+12 ;
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,VALMY
+4 DO EN^VALM2($GET(XQORNOD(0)))
+5 SET IBCOVP=$PIECE($GET(^DPT(DFN,.31)),"^",11)
+6 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
IF 'IBXX!$DATA(DIRUT)
QUIT
Begin DoDot:1
+7 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+8 ; do some error checking here
+9 IF $$DELP^IBCNSU(DFN,$PIECE(IBPPOL,"^",5))
Begin DoDot:2
+10 WRITE !,"You can't delete this policy, there are bills associated with it."
+11 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 !
+12 KILL IBBCNT
+13 QUIT
End DoDot:2
QUIT
+14 ;
+15 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are You Sure you want to delete policy #"_IBXX
+16 DO ^DIR
KILL DIR
IF Y'=1
WRITE !,"Policy #",IBXX," not Deleted!"
QUIT
+17 SET IBCDFN=$PIECE(IBPPOL,"^",4)
+18 DO DP1
+19 QUIT
End DoDot:1
DPQ DO COVERED^IBCNSM31(DFN,$GET(IBCOVP))
+1 DO PAUSE^VALM1
IF $GET(BLD)
DO BLD^IBCNSM
+2 SET VALMBCK="R"
QUIT
+3 ;
DP1 ; -- actual deletion
+1 NEW DA,DIC,DIK
+2 ;
+3 ; -- if individual policy, and is right patient, delete HIP
+4 SET BLD=1
+5 SET IBCPOL=$PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),"^",18)
SET IBCPOLD=$GET(^IBA(355.3,+IBCPOL,0))
+6 IF '$PIECE(IBCPOLD,"^",2)
IF DFN=$PIECE(IBCPOLD,"^",10)
SET DA=IBCPOL
SET DIK="^IBA(355.3,"
DO ^DIK
KILL DA,DIC,DIK
+7 ;
+8 ; -- delete entry in patient file
+9 SET DA=IBCDFN
SET DA(1)=DFN
SET DIK="^DPT("_DFN_",.312,"
DO ^DIK
+10 IF $GET(IBXX)
WRITE !,"Entry ",$GET(IBXX)," Deleted"
+11 QUIT
