Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNSM1

IBCNSM1.m

Go to the documentation of this file.
  1. IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 05-MAY-2015
  1. ;;2.0;INTEGRATED BILLING;**28,56,549**; 21-MAR-94;Build 54
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. % G EN^IBCNSM
  1. ;
  1. VP ; -- View Patient Policy Info
  1. D FULL^VALM1
  1. N I,J,IBXX,VALMY
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D ;W !,"Entry ",X,"Selected" D
  1. .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1. .Q:IBPPOL=""
  1. .D EN^VALM("IBCNS EXPANDED POLICY")
  1. .Q
  1. I '$G(IBFASTXT) D BLD^IBCNSM
  1. S VALMBCK="R" Q
  1. ;
  1. AB ; -- Edit Annual Benefits
  1. D FULL^VALM1
  1. ;
  1. ; IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to edit Annual Benefits."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. ;
  1. N I,J,IBXX,VALMY
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
  1. .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1. .Q:IBPPOL=""
  1. .S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
  1. .D FULL^VALM1
  1. .D EN^VALM("IBCNS ANNUAL BENEFITS")
  1. .Q
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. UP ; -- Print new, not verified insurance
  1. ;
  1. N I,J,IBXX,IBCNS,VALMY
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) W !,IBXX,! H 2 Q:'IBXX D
  1. .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1. .Q:IBPPOL=""
  1. .S IBCNS=$P(IBPPOL,"^",5),IBCPOL=$P(IBPPOL,"^",22)
  1. .S INSCO=^DIC(36,IBCNS,0)
  1. .W !!,$P(INSCO,"^"),!! H 2
  1. .W !!,$P(IBPPOL,"^",4),!! H 2
  1. .Q
  1. D FULL^VALM1
  1. W !!,"REPORT OF NEW NOT VERIFIED INSURANCE",!! H 2
  1. S VALMBCK="R" Q
  1. ;
  1. PC ; -- Print Patient Insurance info
  1. ;N IBLINE,IBCY,IBWP
  1. N IBWP
  1. ;
  1. PCWP ; -- Print Insurance Coverage, Worksheet
  1. ;
  1. N I,J,IBXX,IBLINE,IBCY,VALMY
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
  1. .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1. .Q:IBPPOL=""
  1. .S IBCPOL=$P(IBPPOL,"^",22)
  1. .S IBLINE=$S($G(IBWP):1,1:0)
  1. .S IBCY=$S($G(IBWP):0,1:1)
  1. .D WPPC^IBCNSM5
  1. .Q
  1. S VALMBCK="R" Q
  1. ;
  1. WP ; -- Print Worksheet
  1. N IBWP
  1. S IBWP=1
  1. D PCWP
  1. S VALMBCK="R" Q
  1. ;
  1. DP ; -- Delete insurance policy
  1. D FULL^VALM1
  1. I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D SORRY^IBTRE1 G DPQ
  1. N I,J,IBXX,DIR,DIRUT,IBBCNT,BLD,IBCOVP,IBFNOPOL,VALMY
  1. D EN^VALM2($G(XQORNOD(0)))
  1. S IBCOVP=$P($G(^DPT(DFN,.31)),"^",11)
  1. ; if no policies, set ibfnopol flag to prevent call to pause^valm1
  1. ; at label dpq
  1. I '$D(VALMY) S IBFNOPOL=1
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
  1. .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1. .; do some error checking here
  1. .I $$DELP^IBCNSU(DFN,$P(IBPPOL,"^",5)) D Q
  1. ..W !,"You can't delete this policy, there are bills associated with it."
  1. ..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) !
  1. ..K IBBCNT
  1. ..Q
  1. .;
  1. .; - warn if there are associated Insurance reviews
  1. .I $$IR^IBCNSJ21(DFN,+$P(IBPPOL,"^",4)) W !,*7,"Please note that there are Insurance Reviews associated with this policy!!",!
  1. .;
  1. .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete policy #"_IBXX
  1. .D ^DIR K DIR I Y'=1 W !,"Policy #",IBXX," not Deleted!" Q
  1. .S IBCDFN=$P(IBPPOL,"^",4)
  1. .D DP1
  1. .Q
  1. DPQ D COVERED^IBCNSM31(DFN,$G(IBCOVP))
  1. I '$G(IBFNOPOL) D PAUSE^VALM1
  1. I $G(BLD) D BLD^IBCNSM
  1. S VALMBCK="R" Q
  1. ;
  1. DP1 ; -- actual deletion
  1. N DA,DIC,DIK,IBJJ,IBJJJ,IBBU,IBPLAN,IBCPOLD
  1. S IBPLAN=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18),IBCPOLD=$G(^IBA(355.3,+IBPLAN,0))
  1. ;
  1. ; -- delete riders
  1. S IBJJ=0 F S IBJJ=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBJJ)) Q:'IBJJ D
  1. .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
  1. ;
  1. ; -- delete benefits used
  1. I IBPLAN D BU^IBCNSJ21 S IBJJ="" F S IBJJ=$O(IBBU(IBJJ)) Q:IBJJ="" D DBU^IBCNSJ(IBBU(IBJJ))
  1. ;
  1. ; -- remove pointers from Insurance reviews
  1. 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)=""
  1. ;
  1. ; -- if individual policy, and is right patient, delete HIP
  1. S BLD=1
  1. I '$P(IBCPOLD,"^",2),DFN=$P(IBCPOLD,"^",10) D DEL^IBCNSJ(IBPLAN)
  1. ;
  1. ; -- delete entry in patient file
  1. S DA=IBCDFN,DA(1)=DFN,DIK="^DPT("_DFN_",.312," D ^DIK
  1. W:$G(IBXX) !,"Entry ",$G(IBXX)," Deleted"
  1. Q