- 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
