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

IBCNSP3.m

Go to the documentation of this file.
  1. IBCNSP3 ;ALB/AAS - INSURANCE MANAGEMENT EDIT ; 06-JUL-93
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. % G ^IBCNSM4
  1. ;
  1. SAVEPT(DFN,DA) ; -- Save the global before editing
  1. K ^TMP($J,"IBCNSPT")
  1. S ^TMP($J,"IBCNSPT",2.312,DFN,DA,0)=$G(^DPT(DFN,.312,DA,0))
  1. S ^TMP($J,"IBCNSPT",2.312,DFN,DA,1)=$G(^DPT(DFN,.312,DA,1))
  1. S ^TMP($J,"IBCNSPT",2.312,DFN,DA,2)=$G(^DPT(DFN,.312,DA,2))
  1. Q
  1. ;
  1. COMPPT(DFN,DA) ; -- Compare before editing with globals
  1. S IBDIF=0
  1. I $G(^DPT(DFN,.312,DA,0))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,DA,0)) S IBDIF=1 G COMPPTQ
  1. I $G(^DPT(DFN,.312,DA,1))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,DA,1)) S IBDIF=1 G COMPPTQ
  1. I $G(^DPT(DFN,.312,DA,2))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,DA,2)) S IBDIF=1 G COMPPTQ
  1. ;
  1. COMPPTQ I IBDIF D:'$D(IBCOVP) COVERED^IBCNSM31(DFN,$P($G(^DPT(DFN,.31)),"^",11))
  1. Q
  1. ;
  1. UPDATPT(DFN,DA) ; -- enter date and user if editing has taken place
  1. N DR,DIE,DIC
  1. S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
  1. S DR="1.05///NOW;1.06////"_DUZ
  1. D ^DIE
  1. Q
  1. ;
  1. EM ; -- Employer for claims update
  1. D FULL^VALM1 W !!
  1. N IBDIF,DA,DR,DIC,DIE
  1. D SAVEPT(DFN,IBCDFN)
  1. D VARS
  1. L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EMQ
  1. S DR="2.01;S:'$P($G(^DPT(DFN,.312,+$G(DA),2)),U) Y=""@999"";W !!,""*** If ROI applies, make sure current consent is signed! ***"",!;2.015;2.02;2.03;2.04;2.05;2.06;2.07;2.08;2.09;@999"
  1. D ^DIE K DIE,DR
  1. I '$P($G(^DPT(DFN,.312,+$G(DA),2)),U) D VARS S DR="2.015///@;2.02///@;2.03///@;2.04///@;2.05///@;2.06///@;2.07///@;2.08///@" D ^DIE
  1. D COMPPT(DFN,IBCDFN)
  1. I IBDIF D UPDATPT(DFN,IBCDFN),BLD^IBCNSP
  1. L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
  1. EMQ S VALMBCK="R" Q
  1. ;
  1. AC ; -- Add Comment
  1. D FULL^VALM1 W !!
  1. N IBDIF,DA,DR,DIE,DIC,X,Y
  1. D SAVEPT(DFN,IBCDFN)
  1. W !!,"You may now enter a brief comment about this patient's policy"
  1. D VARS
  1. L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G ACQ
  1. S DR="1.08" D ^DIE
  1. D COMPPT(DFN,IBCDFN) I IBDIF D UPDATPT(DFN,IBCDFN)
  1. L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
  1. W !!,"You may now enter comments about this Group Plan that pertains to all Patients"
  1. L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ACQ
  1. S DIE="^IBA(355.3,",DA=IBCPOL,DR="11" D ^DIE
  1. D BLD^IBCNSP
  1. L -^IBA(355.3,+IBCPOL)
  1. ACQ S VALMBCK="R" Q
  1. ;
  1. BLS(X,Y) ; -- blank a section of lines
  1. N I
  1. F I=X:1:Y D BLANK^IBCNSP(.I)
  1. Q
  1. ;
  1. VARS ; -- set vars for call to die for .312 node
  1. S DA(1)=DFN,DA=$P(IBPPOL,"^",4)
  1. S DIE="^DPT("_DA(1)_",.312,"
  1. Q
  1. ;
  1. SAVE(IBCPOL) ; -- Save the global before editing
  1. K ^TMP($J,"IBCNSP")
  1. S ^TMP($J,"IBCNSP",355.3,IBCPOL,0)=$G(^IBA(355.3,IBCPOL,0))
  1. S ^TMP($J,"IBCNSP",355.3,IBCPOL,1)=$G(^IBA(355.3,IBCPOL,1))
  1. Q
  1. ;
  1. COMP(IBCPOL) ; -- Compare before editing with globals
  1. S IBDIF=0
  1. I $G(^IBA(355.3,IBCPOL,0))'=$G(^TMP($J,"IBCNSP",355.3,IBCPOL,0)) S IBDIF=1 Q
  1. I $G(^IBA(355.3,IBCPOL,1))'=$G(^TMP($J,"IBCNSP",355.3,IBCPOL,1)) S IBDIF=1 Q
  1. Q
  1. ;
  1. UPDATE(IBCPOL) ; -- Update last edited by
  1. N DA,DIC,DIE,DR
  1. S DIE="^IBA(355.3,",DA=IBCPOL,DR="1.05///NOW;1.06////"_DUZ
  1. D ^DIE
  1. Q
  1. ;
  1. RIDERS ; -- add/edit personal riders
  1. ;
  1. D FULL^VALM1
  1. N IBDIF,DA,DR,DIE,DIC,X,Y,IBCDFN,IBPRD,IBPRY
  1. S IBCDFN=$P(IBPPOL,"^",4)
  1. W ! D DISPR W !
  1. ;
  1. R1 S DIC="^IBA(355.7,",DIC(0)="AEQML",DLAYGO=355.7
  1. S DIC("DR")=".02////"_DFN_";.03////"_IBCDFN
  1. S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,3)=IBCDFN"
  1. I $D(IBPRD) S DIC("B")=IBPRD
  1. D ^DIC K DIC,IBPRD
  1. I +Y<1 G RIDERQ
  1. S IBPRY=+Y
  1. L +^IBA(355.7,IBPRY):5 I '$T D LOCKED^IBTRCD1 G RIDERQ
  1. S DIE="^IBA(355.7,",DA=+Y,DR=".01"
  1. D ^DIE K DA,DR,DIE,DIC
  1. L -^IBA(355.7,IBPRY)
  1. W ! G R1
  1. RIDERQ S VALMBCK="R"
  1. Q
  1. ;
  1. RD ; -- Add riders/ for multiple policies
  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
  1. .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1. .Q:IBPPOL=""
  1. .D RIDERS
  1. .Q
  1. D BLD^IBCNSM
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. DISPR ; -- Display riders
  1. N IBPR,I,J
  1. S I=0
  1. I '$G(IBCDFN)!('$G(DFN)) G DISPRQ
  1. W !,"Current Personal Riders: "
  1. F S I=$O(^IBA(355.7,"APP",DFN,IBCDFN,I)) Q:'I S J=$O(^(I,0)),IBPR=$G(^IBA(355.7,+J,0)) D
  1. .S IBPRD=$$EXPAND^IBTRE(355.7,.01,+IBPR)
  1. .W !?5,IBPRD
  1. I '$D(IBPRD) W !?5,"None Indicated"
  1. DISPRQ Q