IBCNSP1 ;ALB/AAS - INSURANCE MANAGEMENT - policy actions ; 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^IBCNSP
;
EA ; -- Edit all
N IBCDFN,IBTRC,IBTRN
D FULL^VALM1 W !!
S IBCDFN=$P($G(IBPPOL),"^",4) I 'IBCDFN W !!,"Can't identify the policy!" G EAQ
S IBCNSEH=1 D PAT^IBCNSEH
;
D PATPOL^IBCNSM3(IBCDFN)
;
; -- edit policy data
D POL^IBCNSEH
D EDPOL^IBCNSM3(IBCDFN)
;
W !! D AI
;
EAQ D:$G(IBTRC) AIP^IBCNSP02(IBTRC)
D BLD^IBCNSP
S VALMBCK="R"
Q
;
AB ; -- Annual Benefits
I '$D(IBCPOL),$D(IBPPOL) S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
I '$G(IBCPOL) W !!,"Can't identify the policy!" S VALMBCK="" G ABQ
D FULL^VALM1 W !!
D EN^VALM("IBCNS ANNUAL BENEFITS")
S VALMBCK="R"
ABQ Q
;
BU ; -- Benefits Used
I '$D(IBCPOL),$D(IBPPOL) S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
I '$G(IBCPOL) W !!,"Can't identify the policy!" S VALMBCK="" G BUQ
D FULL^VALM1 W !!
D EN^VALM("IBCNS BENEFITS USED BY DATE")
S VALMBCK="R"
BUQ Q
;
PI ; -- edit policy information
D FULL^VALM1 W !!
N IBDIF,DA,DR,DIC,DIE
S IBCDFN=$P($G(IBPPOL),"^",4)
;
S IBCPOL=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
I IBCPOL="" S IBCPOL=$$CHIP^IBCNSU($G(^DPT(DFN,.312,IBCDFN,0))) I IBCPOL D ;Stuff in file
.S DIE="^DPT("_DFN_",.312,",DR=".18////"_IBCPOL
.S DA=IBCDFN,DA(1)=DFN
.D ^DIE
.K DA,DR,DIE,DIC
.Q
;
; -- Edit the policy specific info
D SAVE^IBCNSP3(IBCPOL)
L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G PIQ
S DIE="^IBA(355.3,",DR=".02;.03;.04;.09",DA=IBCPOL
D ^DIE K DIC,DIE,DA,DR
D COMP^IBCNSP3(IBCPOL)
I IBDIF D UPDATE^IBCNSP3(IBCPOL),UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
L -^IBA(355.3,+IBCPOL)
PIQ S VALMBCK="R"
Q
;
IT ; -- edit insurance type info
D FULL^VALM1 W !!
N IBDIF,DA,DR,DIC,DIE
D SAVE^IBCNSP3(IBCPOL)
L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ITQ
S DA=IBCPOL,DIE="^IBA(355.3,",DR=".05;.06;.07;.08"
D ^DIE K DIC,DIE,DA,DR
D COMP^IBCNSP3(IBCPOL)
I IBDIF D UPDATE^IBCNSP3(IBCPOL),UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
L -^IBA(355.3,+IBCPOL)
ITQ S VALMBCK="R" Q
;
ED ; -- Edit effective dates
D FULL^VALM1 W !!
N IBDIF,DA,DR,DIE,DIC
D SAVEPT^IBCNSP3(DFN,IBCDFN)
L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EDQ
D VARS^IBCNSP3
S DR="8;3"
D ^DIE K DIC,DIE,DA,DR
D COMPPT^IBCNSP3(DFN,IBCDFN) I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
EDQ S VALMBCK="R" Q
;
VC ; -- Verify Coverage
D FULL^VALM1 W !!
D VFY^IBCNSM2
D BLD^IBCNSP
S VALMBCK="R" Q
;
SU ; -- Subscriber Update
D FULL^VALM1 W !!
N IBDIF,DA,DR,DIC,DIE
D SAVEPT^IBCNSP3(DFN,IBCDFN)
D VARS^IBCNSP3
L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G SUQ
S DR="6;S IBAD=X;I IBAD'=""v"" S Y=""@10"";17///^S X=""`""_DFN;16///^S X=""01"";S Y=""@20"";@10;17;16//^S X=$S(IBAD=""s"":""02"",1:"""");@20;1;.2;"
D ^DIE K DIC,DIE,DA,DR
D COMPPT^IBCNSP3(DFN,IBCDFN)
I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
SUQ S VALMBCK="R" Q
;
IC ; -- Insurance Contact Information
D FULL^VALM1 W !!
N IBDIF,DA,DR,DIC,DIE,IBTRC,DIR,DUOUT,DTOUT,DIRUT,IBTRN
D AI
D:$G(IBTRC) AIP^IBCNSP02(IBTRC),BLD^IBCNSP
S VALMBCK="R" Q
Q
AI ; -- Add ins. verification entry
N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
Q:'$G(DFN)
Q:'$G(IBCDFN) S IBQUIT=0
D AI^IBCNSP02
Q
IBCNSP1 ;ALB/AAS - INSURANCE MANAGEMENT - policy actions ; 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^IBCNSP
+1 ;
EA ; -- Edit all
+1 NEW IBCDFN,IBTRC,IBTRN
+2 DO FULL^VALM1
WRITE !!
+3 SET IBCDFN=$PIECE($GET(IBPPOL),"^",4)
IF 'IBCDFN
WRITE !!,"Can't identify the policy!"
GOTO EAQ
+4 SET IBCNSEH=1
DO PAT^IBCNSEH
+5 ;
+6 DO PATPOL^IBCNSM3(IBCDFN)
+7 ;
+8 ; -- edit policy data
+9 DO POL^IBCNSEH
+10 DO EDPOL^IBCNSM3(IBCDFN)
+11 ;
+12 WRITE !!
DO AI
+13 ;
EAQ IF $GET(IBTRC)
DO AIP^IBCNSP02(IBTRC)
+1 DO BLD^IBCNSP
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
AB ; -- Annual Benefits
+1 IF '$DATA(IBCPOL)
IF $DATA(IBPPOL)
SET IBCNS=$PIECE(IBPPOL,"^",5)
SET IBCPOL=$PIECE(IBPPOL,"^",22)
+2 IF '$GET(IBCPOL)
WRITE !!,"Can't identify the policy!"
SET VALMBCK=""
GOTO ABQ
+3 DO FULL^VALM1
WRITE !!
+4 DO EN^VALM("IBCNS ANNUAL BENEFITS")
+5 SET VALMBCK="R"
ABQ QUIT
+1 ;
BU ; -- Benefits Used
+1 IF '$DATA(IBCPOL)
IF $DATA(IBPPOL)
SET IBCNS=$PIECE(IBPPOL,"^",5)
SET IBCPOL=$PIECE(IBPPOL,"^",22)
+2 IF '$GET(IBCPOL)
WRITE !!,"Can't identify the policy!"
SET VALMBCK=""
GOTO BUQ
+3 DO FULL^VALM1
WRITE !!
+4 DO EN^VALM("IBCNS BENEFITS USED BY DATE")
+5 SET VALMBCK="R"
BUQ QUIT
+1 ;
PI ; -- edit policy information
+1 DO FULL^VALM1
WRITE !!
+2 NEW IBDIF,DA,DR,DIC,DIE
+3 SET IBCDFN=$PIECE($GET(IBPPOL),"^",4)
+4 ;
+5 SET IBCPOL=$PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),"^",18)
+6 ;Stuff in file
IF IBCPOL=""
SET IBCPOL=$$CHIP^IBCNSU($GET(^DPT(DFN,.312,IBCDFN,0)))
IF IBCPOL
Begin DoDot:1
+7 SET DIE="^DPT("_DFN_",.312,"
SET DR=".18////"_IBCPOL
+8 SET DA=IBCDFN
SET DA(1)=DFN
+9 DO ^DIE
+10 KILL DA,DR,DIE,DIC
+11 QUIT
End DoDot:1
+12 ;
+13 ; -- Edit the policy specific info
+14 DO SAVE^IBCNSP3(IBCPOL)
+15 LOCK +^IBA(355.3,+IBCPOL):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO PIQ
+16 SET DIE="^IBA(355.3,"
SET DR=".02;.03;.04;.09"
SET DA=IBCPOL
+17 DO ^DIE
KILL DIC,DIE,DA,DR
+18 DO COMP^IBCNSP3(IBCPOL)
+19 IF IBDIF
DO UPDATE^IBCNSP3(IBCPOL)
DO UPDATPT^IBCNSP3(DFN,IBCDFN)
DO BLD^IBCNSP
+20 LOCK -^IBA(355.3,+IBCPOL)
PIQ SET VALMBCK="R"
+1 QUIT
+2 ;
IT ; -- edit insurance type info
+1 DO FULL^VALM1
WRITE !!
+2 NEW IBDIF,DA,DR,DIC,DIE
+3 DO SAVE^IBCNSP3(IBCPOL)
+4 LOCK +^IBA(355.3,+IBCPOL):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO ITQ
+5 SET DA=IBCPOL
SET DIE="^IBA(355.3,"
SET DR=".05;.06;.07;.08"
+6 DO ^DIE
KILL DIC,DIE,DA,DR
+7 DO COMP^IBCNSP3(IBCPOL)
+8 IF IBDIF
DO UPDATE^IBCNSP3(IBCPOL)
DO UPDATPT^IBCNSP3(DFN,IBCDFN)
DO BLD^IBCNSP
+9 LOCK -^IBA(355.3,+IBCPOL)
ITQ SET VALMBCK="R"
QUIT
+1 ;
ED ; -- Edit effective dates
+1 DO FULL^VALM1
WRITE !!
+2 NEW IBDIF,DA,DR,DIE,DIC
+3 DO SAVEPT^IBCNSP3(DFN,IBCDFN)
+4 LOCK +^DPT(DFN,.312,+$PIECE($GET(IBPPOL),"^",4)):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO EDQ
+5 DO VARS^IBCNSP3
+6 SET DR="8;3"
+7 DO ^DIE
KILL DIC,DIE,DA,DR
+8 DO COMPPT^IBCNSP3(DFN,IBCDFN)
IF IBDIF
DO UPDATPT^IBCNSP3(DFN,IBCDFN)
DO BLD^IBCNSP
+9 LOCK -^DPT(DFN,.312,+$PIECE($GET(IBPPOL),"^",4))
EDQ SET VALMBCK="R"
QUIT
+1 ;
VC ; -- Verify Coverage
+1 DO FULL^VALM1
WRITE !!
+2 DO VFY^IBCNSM2
+3 DO BLD^IBCNSP
+4 SET VALMBCK="R"
QUIT
+5 ;
SU ; -- Subscriber Update
+1 DO FULL^VALM1
WRITE !!
+2 NEW IBDIF,DA,DR,DIC,DIE
+3 DO SAVEPT^IBCNSP3(DFN,IBCDFN)
+4 DO VARS^IBCNSP3
+5 LOCK +^DPT(DFN,.312,+$PIECE($GET(IBPPOL),"^",4)):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO SUQ
+6 SET DR="6;S IBAD=X;I IBAD'=""v"" S Y=""@10"";17///^S X=""`""_DFN;16///^S X=""01"";S Y=""@20"";@10;17;16//^S X=$S(IBAD=""s"":""02"",1:"""");@20;1;.2;"
+7 DO ^DIE
KILL DIC,DIE,DA,DR
+8 DO COMPPT^IBCNSP3(DFN,IBCDFN)
+9 IF IBDIF
DO UPDATPT^IBCNSP3(DFN,IBCDFN)
DO BLD^IBCNSP
+10 LOCK -^DPT(DFN,.312,+$PIECE($GET(IBPPOL),"^",4))
SUQ SET VALMBCK="R"
QUIT
+1 ;
IC ; -- Insurance Contact Information
+1 DO FULL^VALM1
WRITE !!
+2 NEW IBDIF,DA,DR,DIC,DIE,IBTRC,DIR,DUOUT,DTOUT,DIRUT,IBTRN
+3 DO AI
+4 IF $GET(IBTRC)
DO AIP^IBCNSP02(IBTRC)
DO BLD^IBCNSP
+5 SET VALMBCK="R"
QUIT
+6 QUIT
AI ; -- Add ins. verification entry
+1 NEW X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
+2 IF '$GET(DFN)
QUIT
+3 IF '$GET(IBCDFN)
QUIT
SET IBQUIT=0
+4 DO AI^IBCNSP02
+5 QUIT
