source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20PT1.m@ 1458

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1IB20PT1 ;ALB/AAS/NLR - Insurance post init stuff ; 2/22/93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4% I '$O(^IBA(355.3,0)) D ; -- one time updates (ins policy alerady exists
5 .D MAIL ; add new mail group
6 .D SITE ; update site paramters
7 .D DEL ; delete obsolete field in patient file ins. multiple
8 .;D PAT ; x-ref patient file by ins. co., add hip pointer
9 .D INS ; delete data, them dd for ins. address multiple in 36
10 .;D 399 ; add ae x-ref to file 399
11 .;D INPT ; load current inpatients into claims tracking
12 .D ^IB20PT6 ; que off patient file, bill/claims file, CT updates
13 ;
14 Q
15 ;
16DEL ; -- delete insurance address field from insurance type multiple
17 N DA,DIK,DIU,DIC
18 Q:'$D(^DD(2.312,5,0))
19 S DA=5,DA(1)=2.312,DIK="^DD("_DA(1)_"," D ^DIK
20 W !!,"<<< Deleting Obsolete field *INSURANCE ADDRESS from Patient File Data Dictionary"
21DELQ K DA,DIK,DIU
22 Q
23 ;
24INS ; -- delete address subfile
25 ; first delete the data
26 N DIC,DIE,DA,DR,DIK,DIU
27 Q:'$D(^DD(36.02,0))
28 W !!,"<<< Deleting Obsolete *ADDRESS data from Insurance Company Entries"
29 W !!," I'll write a dot for each 100 entries"
30 S IBD0=0
31 F S IBD0=$O(^DIC(36,IBD0)) Q:'IBD0 S IBD1=0 F S IBD1=$O(^DIC(36,IBD0,2,IBD1)) Q:'IBD1 D K ^DIC(36,IBD0,2)
32 .S DIK="^DIC(36,"_IBD0_",2,",DA=IBD1,DA(1)=IBD0
33 .D ^DIK
34 .K DA,DIC,DIK
35 .S IBCNT=$G(IBCNT)+1
36 .W:'(IBCNT#100) "."
37 .Q
38 ;
39 ; -- Now delete the dd
40 S DIU=36.02,DIU(0)="S" D EN^DIU2
41 W !!,"<<< Deleting Obsolete subfile *ADDRESS from Insurance Company File Data Dictionary"
42INSQ K DIU
43 Q
44 ;
45PAT ; -- create AB x-ref on patient file for all insurance co. pointers
46 W !!,"<<< Cross-referencing patient file by Insurance company and",!," Updating Health Insurance Policy Pointers"
47 W !!," I'll write a dot for each 100 entries"
48 D NOW^%DTC W !," Start time: " S Y=% D DT^DIQ
49 N DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP
50 S (IBCNT,IBCNTP,IBCNTPP,DFN)=0
51 F S DFN=$O(^DPT(DFN)) Q:'DFN S IBCNT=IBCNT+1,IBI=0 F S IBI=$O(^DPT(DFN,.312,IBI)) Q:'IBI D
52 .W:'(IBCNTPP#100) "."
53 .S IBCDFND=$G(^DPT(DFN,.312,IBI,0))
54 .S ^DPT("AB",+IBCDFND,DFN,IBI)=""
55 .S ^DPT(DFN,.312,"B",+IBCDFND,IBI)=""
56 .Q:$P(IBCDFND,U,18)
57 .S IBCPOL=$$CHIP^IBCNSU(IBCDFND)
58 .Q:'IBCPOL
59 .S IBCNTPP=IBCNTPP+1
60 .S DA=IBI,DA(1)=DFN,DIE="^DPT("_DFN_",.312,"
61 .S DR="1.09////1;.18////"_IBCPOL
62 .D ^DIE K DA,DR,DIE,DIC
63 .Q
64 W !!,"<<< Health Insurance Policy information updated"
65 W !," there were ",IBCNTPP," Policies for ",IBCNT," Patients were updated"
66 W !," causing ",IBCNTP," Health Insurance Policies to be added"
67 D NOW^%DTC W !," Finish Time: " S Y=% D DT^DIQ
68 Q
69 ;
70399 ; -- create new AE x-ref of file 399
71 N IBCIFN,IBCNT
72 W !!,"<<< Cross-referencing Bill/Claims file by Primary Insurer"
73 W !!," I'll write a dot for each 100 entries"
74 S IBCIFN=0,IBCNT=0
75 F S IBCIFN=$O(^DGCR(399,IBCIFN)) Q:'IBCIFN D
76 .I +$G(^DGCR(399,IBCIFN,"M")),$P($G(^(0)),"^",2) S ^DGCR(399,"AE",$P(^(0),"^",2),+^("M"),IBCIFN)=""
77 .S IBCNT=$G(IBCNT)+1 W:'(IBCNT#100) "."
78 Q
79 ;
80INPT ; -- load current inpatients into claims tracking
81 W !!,"<<< Loading current inpatients into Claims Tracking"
82 N WARD,DGPMDA,IBCNT,IB20
83 S WARD="",DGPDMA=0,IBCNT=0,IB20=1
84 F S WARD=$O(^DGPM("CN",WARD)) Q:WARD="" S DGPMDA=0 F S DGPMDA=$O(^DGPM("CN",WARD,DGPMDA)) Q:'DGPMDA D
85 .S DGPMP=""
86 .S DGPMA=$G(^DGPM(DGPMDA,0))
87 .S DFN=$P(DGPMA,"^",3)
88 .D INP^VADPT
89 .K IBNEW D INP^IBTRKR
90 .I $G(IBNEW) S IBCNT=IBCNT+1 W !," Patient ",$P(^DPT(DFN,0),U)," added to the Claims tracking module"
91 ;
92 W !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
93 Q
94 ;
95MAIL ; -- add new mail group
96 ;Q:$D(^XMB(3.8,"B","IB NEW INSURANCE"))
97 S DLAYGO=3.8,DIC="^XMB(3.8,",DIC(0)="LX",DIC("DR")="4////PU;5////"_DUZ,X="IB NEW INSURANCE" D ^DIC K DIC I +Y>0 S IBCNMAIL=+Y
98 S ^XMB(3.8,+Y,2,0)="^^1^1^2900625^"
99 S ^XMB(3.8,+Y,2,1,0)="This mail group will receive notification whenever a new insurance policy is added."
100 W !!,"<<< Mail Group 'IB NEW INSURANCE' ",$S($P(Y,"^",3):"added...",1:"updated...")
101 W !!," Remember to add Members to this group"
102 Q
103 ;
104SITE ; -- setup ib site parameters
105 N DIE,DA,DR,DIC,DD,DO S DR=""
106 W !!,"<<< Updating new site parameters automatically!"
107 ;
108 ; -- if no entry add one
109 I '$D(^IBE(350.9,1,0)) S (X,DINUM)=1,DIC="^IBE(350.9,",DIC(0)="L" K DD,DO D FILE^DICN K DIC S DR=".03///1;.02////^S X=+$$SITE^VASITE;.08///2;.09///IB ERROR;",DA=1,DIE="^IBE(350.9," D ^DIE K DR,DA,DIE,DIC
110 ;
111 S DA=1,DIE="^IBE(350.9,"
112 S DR="4.01////1;4.04////"_$G(IBCNMAIL)_";6.01///^S X=DT;6.02////1;6.02////1;6.03////1;6.04////1;6.05////1;6.06////1;6.07///^S X=DT;6.08////1;6.09////5;6.13////1;6.14////5;6.18////1;6.19////1"
113 D ^DIE K DIE,DA,DR,DIC,DD,DO W !
114 Q
Note: See TracBrowser for help on using the repository browser.