- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP3.m
r613 r623 1 IBCNSP3 ;ALB/AAS - INSURANCE MANAGEMENT EDIT ;06-JUL-93 2 ;;2.0;INTEGRATED BILLING;**28,52,85,251,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 % G ^IBCNSM4 6 ; 7 SAVEPT(DFN,DA) ; -- Save the global before editing 8 K ^TMP($J,"IBCNSPT") 9 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,0)=$G(^DPT(DFN,.312,+DA,0)) 10 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,1)=$G(^DPT(DFN,.312,+DA,1)) 11 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,2)=$G(^DPT(DFN,.312,+DA,2)) 12 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,3)=$G(^DPT(DFN,.312,+DA,3)) 13 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,4)=$G(^DPT(DFN,.312,+DA,4)) 14 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,5)=$G(^DPT(DFN,.312,+DA,5)) 15 Q 16 ; 17 COMPPT(DFN,DA) ; -- Compare before editing with globals 18 S IBDIF=0 19 I $G(^DPT(DFN,.312,+DA,0))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,0)) S IBDIF=1 G COMPPTQ 20 I $G(^DPT(DFN,.312,+DA,1))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,1)) S IBDIF=1 G COMPPTQ 21 I $G(^DPT(DFN,.312,+DA,2))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,2)) S IBDIF=1 G COMPPTQ 22 I $G(^DPT(DFN,.312,+DA,3))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,3)) S IBDIF=1 G COMPPTQ 23 I $G(^DPT(DFN,.312,+DA,4))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,4)) S IBDIF=1 G COMPPTQ 24 I $G(^DPT(DFN,.312,+DA,5))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,5)) S IBDIF=1 G COMPPTQ 25 ; 26 COMPPTQ I IBDIF D:'$D(IBCOVP) COVERED^IBCNSM31(DFN,$P($G(^DPT(DFN,.31)),"^",11)) 27 Q 28 ; 29 UPDATPT(DFN,DA) ; -- enter date and user if editing has taken place 30 N DR,DIE,DIC 31 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN 32 S DR="1.05///NOW;1.06////"_DUZ 33 D ^DIE 34 Q 35 ; 36 EM ; -- Employer for claims update 37 D FULL^VALM1 W !! 38 N IBDIF,DA,DR,DIC,DIE 39 D SAVEPT(DFN,IBCDFN) 40 D VARS 41 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EMQ 42 ; 43 ;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" 44 ; 45 S DR="2.1" D ^DIE K DIE,DR 46 ; 47 I +$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10),$P($G(^DPT(DFN,.312,+$G(DA),2)),U,9)="" D EMPSET(DFN,$G(DA)) ; curr emp 48 ; 49 I +$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10) D VARS S DR="2.015;2.11;2.12;2.01;W:+X !!,""*** If ROI applies, make sure current consent is signed! ***"",!!;2.02;2.03;2.04;2.05;2.06;2.07;2.08;@999" D ^DIE K DIE,DR 50 ; 51 ;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 52 ; 53 I '$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10) D VARS S DR="2.01///@;2.015///@;2.02///@;2.03///@;2.04///@;2.05///@;2.06///@;2.07///@;2.08///@;2.11///@;2.12///@" D ^DIE 54 ; 55 D COMPPT(DFN,IBCDFN) 56 I IBDIF D UPDATPT(DFN,IBCDFN),BLD^IBCNSP 57 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)) 58 EMQ S VALMBCK="R" Q 59 ; 60 AC ; -- Add Comment 61 D FULL^VALM1 W !! 62 N IBDIF,DA,DR,DIE,DIC,X,Y 63 D SAVEPT(DFN,IBCDFN) 64 W !!,"You may now enter a brief comment about this patient's policy" 65 D VARS 66 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G ACQ 67 S DR="1.08" D ^DIE 68 D COMPPT(DFN,IBCDFN) I IBDIF D UPDATPT(DFN,IBCDFN) 69 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)) 70 W !!,"You may now enter comments about this Group Plan that pertains to all Patients" 71 L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ACQ 72 S DIE="^IBA(355.3,",DA=IBCPOL,DR="11" D ^DIE 73 D BLD^IBCNSP 74 L -^IBA(355.3,+IBCPOL) 75 ACQ S VALMBCK="R" Q 76 ; 77 BLS(X,Y) ; -- blank a section of lines 78 N I 79 F I=X:1:Y D BLANK^IBCNSP(.I) 80 Q 81 ; 82 VARS ; -- set vars for call to die for .312 node 83 S DA(1)=DFN,DA=$P(IBPPOL,"^",4) 84 S DIE="^DPT("_DA(1)_",.312," 85 Q 86 ; 87 SAVE(IBCPOL) ; -- Save the global before editing 88 K ^TMP($J,"IBCNSP") 89 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,0)=$G(^IBA(355.3,+IBCPOL,0)) 90 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,1)=$G(^IBA(355.3,+IBCPOL,1)) 91 ;;Daou/EEN - adding BIN and PCN 92 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,6)=$G(^IBA(355.3,+IBCPOL,6)) 93 Q 94 ; 95 COMP(IBCPOL) ; -- Compare before editing with globals 96 S IBDIF=0 97 I $G(^IBA(355.3,+IBCPOL,0))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,0)) S IBDIF=1 Q 98 I $G(^IBA(355.3,+IBCPOL,1))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,1)) S IBDIF=1 Q 99 ;;Daou/EEN - adding BIN and PCN 100 I $G(^IBA(355.3,+IBCPOL,6))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,6)) S IBDIF=1 Q 101 Q 102 ; 103 UPDATE(IBCPOL) ; -- Update last edited by 104 N DA,DIC,DIE,DR 105 S DIE="^IBA(355.3,",DA=IBCPOL,DR="1.05///NOW;1.06////"_DUZ 106 D ^DIE 107 Q 108 ; 109 RIDERS ; -- add/edit personal riders 110 ; 111 D FULL^VALM1 112 N IBDIF,DA,DR,DIE,DIC,X,Y,IBCDFN,IBPRD,IBPRY 113 S IBCDFN=$P(IBPPOL,"^",4) 114 W ! D DISPR W ! 115 ; 116 R1 S DIC="^IBA(355.7,",DIC(0)="AEQML",DLAYGO=355.7 117 S DIC("DR")=".02////"_DFN_";.03////"_IBCDFN 118 S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,3)=IBCDFN" 119 I $D(IBPRD) S DIC("B")=IBPRD 120 D ^DIC K DIC,IBPRD 121 I +Y<1 G RIDERQ 122 S IBPRY=+Y 123 L +^IBA(355.7,IBPRY):5 I '$T D LOCKED^IBTRCD1 G RIDERQ 124 S DIE="^IBA(355.7,",DA=+Y,DR=".01",DIDEL=355.7 125 D ^DIE K DA,DR,DIE,DIC,DIDEL 126 L -^IBA(355.7,IBPRY) 127 W ! G R1 128 RIDERQ S VALMBCK="R" 129 Q 130 ; 131 RD ; -- Add riders/ for multiple policies 132 D FULL^VALM1 133 N I,J,IBXX,VALMY 134 D EN^VALM2($G(XQORNOD(0))) 135 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D 136 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0)))) 137 .Q:IBPPOL="" 138 .D RIDERS 139 .Q 140 D BLD^IBCNSM 141 S VALMBCK="R" 142 Q 143 ; 144 DISPR ; -- Display riders 145 N IBPR,I,J 146 S I=0 147 I '$G(IBCDFN)!('$G(DFN)) G DISPRQ 148 W !,"Current Personal Riders: " 149 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 150 .S IBPRD=$$EXPAND^IBTRE(355.7,.01,+IBPR) 151 .W !?5,IBPRD 152 I '$D(IBPRD) W !?5,"None Indicated" 153 DISPRQ Q 154 ; 155 EMPSET(DFN,IBCPOL) ; insert patient or spouses current employer as ESGHP address if that employer sponsors this plan 156 N IBWHOS,VAOA,DIR,IBE,IBEMPST,DR,X,Y 157 I +$G(DFN) S IBWHOS=$P($G(^DPT(DFN,.312,+$G(IBCPOL),0)),U,6) S VAOA("A")=$S(IBWHOS="v":5,IBWHOS="s":6,1:"") 158 I $G(VAOA("A"))'="" D OAD^VADPT I $G(VAOA(9))'="" D 159 . ; 160 . S DIR("A")="Current Employer "_VAOA(9)_" Sponsors this Plan",DIR("B")="No",DIR(0)="Y" W ! D ^DIR W ! Q:'Y W "...." 161 . D VARS S IBE=$S(IBWHOS="v":.311,1:.25),IBEMPST=$P($G(^DPT(DFN,IBE)),U,15) 162 . ; 163 . S DR="2.015///"_VAOA(9)_";2.02///"_VAOA(1)_";2.03///"_VAOA(2)_";2.04///"_VAOA(3)_";2.05///"_VAOA(4) D ^DIE 164 . S DR="2.06////"_$P(VAOA(5),U,1)_";2.07////"_$P(VAOA(11),U,1)_";2.08///"_$E(VAOA(8),1,15)_";2.11////"_IBEMPST D ^DIE 165 Q 1 IBCNSP3 ;ALB/AAS - INSURANCE MANAGEMENT EDIT ; 06-JUL-93 2 ;;2.0;INTEGRATED BILLING;**28,52,85,251**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 % G ^IBCNSM4 6 ; 7 SAVEPT(DFN,DA) ; -- Save the global before editing 8 K ^TMP($J,"IBCNSPT") 9 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,0)=$G(^DPT(DFN,.312,+DA,0)) 10 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,1)=$G(^DPT(DFN,.312,+DA,1)) 11 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,2)=$G(^DPT(DFN,.312,+DA,2)) 12 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,3)=$G(^DPT(DFN,.312,+DA,3)) 13 S ^TMP($J,"IBCNSPT",2.312,DFN,+DA,4)=$G(^DPT(DFN,.312,+DA,4)) 14 Q 15 ; 16 COMPPT(DFN,DA) ; -- Compare before editing with globals 17 S IBDIF=0 18 I $G(^DPT(DFN,.312,+DA,0))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,0)) S IBDIF=1 G COMPPTQ 19 I $G(^DPT(DFN,.312,+DA,1))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,1)) S IBDIF=1 G COMPPTQ 20 I $G(^DPT(DFN,.312,+DA,2))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,2)) S IBDIF=1 G COMPPTQ 21 I $G(^DPT(DFN,.312,+DA,3))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,3)) S IBDIF=1 G COMPPTQ 22 I $G(^DPT(DFN,.312,+DA,4))'=$G(^TMP($J,"IBCNSPT",2.312,DFN,+DA,4)) S IBDIF=1 G COMPPTQ 23 ; 24 COMPPTQ I IBDIF D:'$D(IBCOVP) COVERED^IBCNSM31(DFN,$P($G(^DPT(DFN,.31)),"^",11)) 25 Q 26 ; 27 UPDATPT(DFN,DA) ; -- enter date and user if editing has taken place 28 N DR,DIE,DIC 29 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN 30 S DR="1.05///NOW;1.06////"_DUZ 31 D ^DIE 32 Q 33 ; 34 EM ; -- Employer for claims update 35 D FULL^VALM1 W !! 36 N IBDIF,DA,DR,DIC,DIE 37 D SAVEPT(DFN,IBCDFN) 38 D VARS 39 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EMQ 40 ; 41 ;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" 42 ; 43 S DR="2.1" D ^DIE K DIE,DR 44 ; 45 I +$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10),$P($G(^DPT(DFN,.312,+$G(DA),2)),U,9)="" D EMPSET(DFN,$G(DA)) ; curr emp 46 ; 47 I +$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10) D VARS S DR="2.015;2.11;2.12;2.01;W:+X !!,""*** If ROI applies, make sure current consent is signed! ***"",!!;2.02;2.03;2.04;2.05;2.06;2.07;2.08;@999" D ^DIE K DIE,DR 48 ; 49 ;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 50 ; 51 I '$P($G(^DPT(DFN,.312,+$G(DA),2)),U,10) D VARS S DR="2.01///@;2.015///@;2.02///@;2.03///@;2.04///@;2.05///@;2.06///@;2.07///@;2.08///@;2.11///@;2.12///@" D ^DIE 52 ; 53 D COMPPT(DFN,IBCDFN) 54 I IBDIF D UPDATPT(DFN,IBCDFN),BLD^IBCNSP 55 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)) 56 EMQ S VALMBCK="R" Q 57 ; 58 AC ; -- Add Comment 59 D FULL^VALM1 W !! 60 N IBDIF,DA,DR,DIE,DIC,X,Y 61 D SAVEPT(DFN,IBCDFN) 62 W !!,"You may now enter a brief comment about this patient's policy" 63 D VARS 64 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G ACQ 65 S DR="1.08" D ^DIE 66 D COMPPT(DFN,IBCDFN) I IBDIF D UPDATPT(DFN,IBCDFN) 67 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)) 68 W !!,"You may now enter comments about this Group Plan that pertains to all Patients" 69 L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ACQ 70 S DIE="^IBA(355.3,",DA=IBCPOL,DR="11" D ^DIE 71 D BLD^IBCNSP 72 L -^IBA(355.3,+IBCPOL) 73 ACQ S VALMBCK="R" Q 74 ; 75 BLS(X,Y) ; -- blank a section of lines 76 N I 77 F I=X:1:Y D BLANK^IBCNSP(.I) 78 Q 79 ; 80 VARS ; -- set vars for call to die for .312 node 81 S DA(1)=DFN,DA=$P(IBPPOL,"^",4) 82 S DIE="^DPT("_DA(1)_",.312," 83 Q 84 ; 85 SAVE(IBCPOL) ; -- Save the global before editing 86 K ^TMP($J,"IBCNSP") 87 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,0)=$G(^IBA(355.3,+IBCPOL,0)) 88 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,1)=$G(^IBA(355.3,+IBCPOL,1)) 89 ;;Daou/EEN - adding BIN and PCN 90 S ^TMP($J,"IBCNSP",355.3,+IBCPOL,6)=$G(^IBA(355.3,+IBCPOL,6)) 91 Q 92 ; 93 COMP(IBCPOL) ; -- Compare before editing with globals 94 S IBDIF=0 95 I $G(^IBA(355.3,+IBCPOL,0))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,0)) S IBDIF=1 Q 96 I $G(^IBA(355.3,+IBCPOL,1))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,1)) S IBDIF=1 Q 97 ;;Daou/EEN - adding BIN and PCN 98 I $G(^IBA(355.3,+IBCPOL,6))'=$G(^TMP($J,"IBCNSP",355.3,+IBCPOL,6)) S IBDIF=1 Q 99 Q 100 ; 101 UPDATE(IBCPOL) ; -- Update last edited by 102 N DA,DIC,DIE,DR 103 S DIE="^IBA(355.3,",DA=IBCPOL,DR="1.05///NOW;1.06////"_DUZ 104 D ^DIE 105 Q 106 ; 107 RIDERS ; -- add/edit personal riders 108 ; 109 D FULL^VALM1 110 N IBDIF,DA,DR,DIE,DIC,X,Y,IBCDFN,IBPRD,IBPRY 111 S IBCDFN=$P(IBPPOL,"^",4) 112 W ! D DISPR W ! 113 ; 114 R1 S DIC="^IBA(355.7,",DIC(0)="AEQML",DLAYGO=355.7 115 S DIC("DR")=".02////"_DFN_";.03////"_IBCDFN 116 S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,3)=IBCDFN" 117 I $D(IBPRD) S DIC("B")=IBPRD 118 D ^DIC K DIC,IBPRD 119 I +Y<1 G RIDERQ 120 S IBPRY=+Y 121 L +^IBA(355.7,IBPRY):5 I '$T D LOCKED^IBTRCD1 G RIDERQ 122 S DIE="^IBA(355.7,",DA=+Y,DR=".01",DIDEL=355.7 123 D ^DIE K DA,DR,DIE,DIC,DIDEL 124 L -^IBA(355.7,IBPRY) 125 W ! G R1 126 RIDERQ S VALMBCK="R" 127 Q 128 ; 129 RD ; -- Add riders/ for multiple policies 130 D FULL^VALM1 131 N I,J,IBXX,VALMY 132 D EN^VALM2($G(XQORNOD(0))) 133 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D 134 .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0)))) 135 .Q:IBPPOL="" 136 .D RIDERS 137 .Q 138 D BLD^IBCNSM 139 S VALMBCK="R" 140 Q 141 ; 142 DISPR ; -- Display riders 143 N IBPR,I,J 144 S I=0 145 I '$G(IBCDFN)!('$G(DFN)) G DISPRQ 146 W !,"Current Personal Riders: " 147 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 148 .S IBPRD=$$EXPAND^IBTRE(355.7,.01,+IBPR) 149 .W !?5,IBPRD 150 I '$D(IBPRD) W !?5,"None Indicated" 151 DISPRQ Q 152 ; 153 EMPSET(DFN,IBCPOL) ; insert patient or spouses current employer as ESGHP address if that employer sponsors this plan 154 N IBWHOS,VAOA,DIR,IBE,IBEMPST,DR,X,Y 155 I +$G(DFN) S IBWHOS=$P($G(^DPT(DFN,.312,+$G(IBCPOL),0)),U,6) S VAOA("A")=$S(IBWHOS="v":5,IBWHOS="s":6,1:"") 156 I $G(VAOA("A"))'="" D OAD^VADPT I $G(VAOA(9))'="" D 157 . ; 158 . S DIR("A")="Current Employer "_VAOA(9)_" Sponsors this Plan",DIR("B")="No",DIR(0)="Y" W ! D ^DIR W ! Q:'Y W "...." 159 . D VARS S IBE=$S(IBWHOS="v":.311,1:.25),IBEMPST=$P($G(^DPT(DFN,IBE)),U,15) 160 . ; 161 . S DR="2.015///"_VAOA(9)_";2.02///"_VAOA(1)_";2.03///"_VAOA(2)_";2.04///"_VAOA(3)_";2.05///"_VAOA(4) D ^DIE 162 . S DR="2.06////"_$P(VAOA(5),U,1)_";2.07////"_$P(VAOA(11),U,1)_";2.08///"_$E(VAOA(8),1,15)_";2.11////"_IBEMPST D ^DIE 163 Q
Note:
See TracChangeset
for help on using the changeset viewer.
