source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSC3.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBCNSC3 ;ALB/NLR - INACTIVATE AND REPOINT INS STUFF1 ; 20-APR-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28,46,68**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5RPTASK ; -- ask if user wishes to repoint patients to active insurance company
6 ;
7 S DIR(0)="YO",DIR("A")="DO YOU WISH TO REPOINT "_$S(IBC=1:"THIS PATIENT",1:"THESE PATIENTS")_" TO ANOTHER INSURANCE COMPANY",DIR("B")="No"
8 W ! D ^DIR K DIR I 'Y!$D(DIRUT) D:$G(IBCOV) COVD G RPTASKQ
9 ;
10 ; - select company to which policies/plans should be repointed
11 S DIC="^DIC(36,",DIC(0)="QEAZ",DIC("A")="REPOINT "_$S(IBC=1:"THIS PATIENT",1:"THESE PATIENTS")_" TO WHICH (ACTIVE) INSURANCE COMPANY: ",DIC("S")="I +$P(^(0),U,5)=0,+$P(^(0),U,16)'=Y,$G(IBCNS)'=Y",DIC("W")="D ID^IBCNSCD3"
12 W ! D ^DIC K DIC S IBR=+Y I Y<1!$D(DIRUT) D:$G(IBCOV) COVD G RPTASKQ
13 ;
14 ; - save the new company in the inactivated company
15 S DA=IBCNS,DR=".16////"_IBR,DIE="^DIC(36," D ^DIE K DIE,DA,DR
16 ;
17 ; - repoint patient policy information
18 S DFN=0 F S DFN=$O(^DPT("AB",IBCNS,DFN)) Q:'DFN D
19 .S IBD=0 F S IBD=$O(^DPT("AB",IBCNS,DFN,IBD)) Q:'IBD D
20 ..;
21 ..; - repoint the policy to the new company
22 ..S IBXXX='$G(^DPT(DFN,.312,IBD,1))
23 ..S DIE="^DPT(DFN,.312,",DA(1)=DFN,DA=IBD,DR=".01///`"_IBR_";1.05///NOW;1.06////"_DUZ D ^DIE K DIE,DA,DR
24 ..I IBXXX S $P(^DPT(DFN,.312,IBD,1),"^",1,2)="^"
25 ..;
26 ..; - repoint Insurance Reviews to the new company
27 ..S IBX=0 F S IBX=$O(^IBT(356.2,"D",DFN,IBX)) Q:'IBX I $P($G(^IBT(356.2,IBX,1)),"^",5)=IBD S DIE="^IBT(356.2,",DA=IBX,DR=".08////"_IBR D ^DIE K DIE,DA,DR
28 .;
29 .; - adjust 'Covered by Insurance' prompt
30 .D COV^IBCNSJ(DFN)
31 ;
32 ; - repoint all plans
33 S IBD=0 F S IBD=$O(^IBA(355.3,"B",IBCNS,IBD)) Q:'IBD D
34 .S DIE="^IBA(355.3,",DA=IBD,DR=".01///`"_IBR D ^DIE K DIE,DA,DR
35 ;
36RPTASKQ K DIRUT,DTOUT,DUOUT,DIROUT,DFN,IBD,IBR,IBX,IBXXX
37 Q
38 ;
39COVD ; Adjust 'Covered by Insurance' prompt for repointed patients
40 S DFN=0 F S DFN=$O(^DPT("AB",IBCNS,DFN)) Q:'DFN D COV^IBCNSJ(DFN)
41 Q
42 ;
43 ;
44 ;
45VERIFY ; -- allow user to change mind about inactivating company
46 ;
47 S DIR("B")="No",DIR(0)="YO",DIR("A")="ARE YOU REALLY SURE YOU WISH TO INACTIVATE "_IBN
48 S DIR("?",1)="You are about to change "_IBN_" to inactive."
49 S DIR("?",2)="This means you will no longer be able to bill "
50 S DIR("?")=IBN_" for its patients' charges."
51 W ! D ^DIR K DIR I $D(DIRUT) S IBQUIT=1
52 S:Y IBV=1
53 Q
54 ;
55HDR ; -- print header
56 ;
57 N X,TAB
58 W:$E(IOST,1,2)["C-"!($G(IBPAG)) @IOF
59 S IBPAG=$G(IBPAG)+1
60 W !,?1,"PATIENTS WITH "_$S(+IBV=0:"ACTIVE",+IBV=1:"INACTIVATED")_" INSURANCE, "_$P(^DIC(36,IBCNS,0),U),?69,"PAGE ",IBPAG,?77,$$DAT1^IBOUTL(DT)
61 ;
62 ; - display Insurance Company name and address.
63 S X=$G(^DIC(36,+IBCNS,.11)),TAB=$S('IBV:33,1:38)
64 W:$P(X,"^")]"" !?TAB,$P(X,"^")
65 W:$P(X,"^",2)]"" !?TAB,$P(X,"^",2)
66 W:$P(X,"^",3)]"" !?TAB,$P(X,"^",3)
67 W:$P(X,"^")]""!($P(X,"^",2)]"")!($P(X,"^",3)]"") !?TAB
68 W $P(X,"^",4) W:$P(X,"^",4)]""&($P(X,"^",5)]"") ", "
69 W $P($G(^DIC(5,+$P(X,"^",5),0)),"^")
70 W:$P(X,"^",6)]""&($P(X,"^",4)]""!($P(X,"^",5)]"")) " "
71 W $E($P(X,"^",6),1,5),$S($E($P(X,"^",6),6,9)]"":"-"_$E($P(X,"^",6),6,9),1:"")
72 ;
73 W !?1,"PATIENT",?31,"PATIENT ID",?45,"IR?",?52,"EFF DATE",?63,"EXP DATE",?74,"SUBSCR ID",?95,"WHOSE INS",?106,"EMPLOYER",!
74 W $TR($J(" ",IOM)," ","-")
75 Q
76 ;
77BUILD ; -- set list of patients in ^tmp array
78 ;
79 K ^TMP($J,"IBCNSC2")
80 S DFN=0 F S DFN=$O(^DPT("AB",IBCNS,DFN)) Q:'DFN D
81 .D COV^IBCNSJ(DFN)
82 .S X=$$PT^IBEFUNC(DFN),IBNA=$P(X,U,1),IBNO=$P(X,U,2)
83 .S:IBNA="" IBNA="<Pt. "_DFN_" Name Missing>"
84 .S IBD=0 F S IBD=$O(^DPT("AB",IBCNS,DFN,IBD)) Q:'IBD D
85 ..S IBIND=$G(^DPT(DFN,.312,IBD,0))
86 ..I IBCNS'=$P(+IBIND,U) Q ;bad x-ref,maybe later take action
87 ..D SET
88 Q
89 ;
90SET ; -- store data to be printed in temp array
91 ;
92 ; ^tmp($j,"ibcnsc2",patient name,dfn,ien of policy) =
93 ; patient id^IR?^effective date^expiration date^subscriber id^whose insurance^employer
94 ;
95 S IBWI=$P(IBIND,"^",6)
96 S VAOA("A")=$S(IBWI="v":5,IBWI="s":6,1:5)
97 D OAD^VADPT
98 S ^TMP($J,"IBCNSC2",IBNA,DFN,IBD)=IBNO_"^"_$S($$IR^IBCNSJ21(DFN,IBD):"Y",1:"N")_"^"_$P(IBIND,"^",8)_U_$P(IBIND,"^",4)_"^"_$P(IBIND,"^",2)_"^"_IBWI_"^"_VAOA(9)
99 Q
Note: See TracBrowser for help on using the repository browser.