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

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1IBCNRRP2 ;DAOU/CMW - IBCNR GROUP PLAN WORKSHEET COMPILE ;03-MAR-2004
2 ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; ePHARM GROUP PLAN WORKSHEET REPORT
6 ;
7 ; Input variables from IBCNRRP1:
8 ; IBCNRRTN = "IBCNRRP1"
9 ; IBCNRSPC("BEGDT") = Start Date for date range
10 ; IBCNRSPC("ENDDT") = End Date for date range
11 ; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims
12 ; 3 - Total Charges; 4 - BIN/PCN Exceptions
13 ; Output variables passed to IBCNRRP3:
14 ; ^XTMP(IBCNRRTN)
15 ; Must call at EN tag
16 Q
17 ;
18EN(IBCNRRTN,IBCNRSPC) ; Entry point
19 ;
20 ; Initialize variables
21 N IBCNRDT,IBCNRDT1,IBCNRDT2,IBCNRPY,IBCNRPYR,IBCNRPTR
22 N IBCNRTOT,IBCNRSRT,RPTDATA,IEN,IBCNRRUN
23 N IBPNM,IBPIEN,ERR,PC,PYR,IBCNRBCI
24 ;
25 I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
26 ;
27 ; Total responses selected
28 S IBCNRTOT=0
29 ;
30 ; Kill scratch global
31 K ^XTMP(IBCNRRTN)
32 ;
33 ; Initialize looping variables
34 S IBCNRDT2=$G(IBCNRSPC("ENDDT"))
35 S IBCNRDT1=$G(IBCNRSPC("BEGDT"))
36 S IBCNRSRT=$G(IBCNRSPC("SORT"))
37 S IBCNRRUN=$$HTE^XLFDT($H,1)
38 S ^XTMP(IBCNRRTN,0)=DT_U_(DT+10000)_U_"Scratch Global for IBCNR GROUP PLAN WORKSHEET report"
39 S ^XTMP(IBCNRRTN,0,0)=IBCNRDT1_"^"_IBCNRDT2_"^"_IBCNRRUN
40 ;
41 ; Loop through the Bill/Claims file
42 ; Authorization Date Cross-Reference
43 ; xref APD3 - Authorized Claims only
44 ; xref APD - All entered Claims
45 S IBCNRDT=$O(^DGCR(399,"APD3",IBCNRDT1),-1)
46 F S IBCNRDT=$O(^DGCR(399,"APD3",IBCNRDT)) Q:IBCNRDT=""!($P(IBCNRDT,".",1)>IBCNRDT2) D Q:$G(ZTSTOP)
47 . S IBCNRBCI=0
48 . F S IBCNRBCI=$O(^DGCR(399,"APD3",IBCNRDT,IBCNRBCI)) Q:'IBCNRBCI D Q:$G(ZTSTOP)
49 .. ; Update selected count
50 .. S IBCNRTOT=IBCNRTOT+1
51 .. ;I $D(ZTQUEUED),IBCNRTOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
52 .. ;
53 .. ; Now get the data for the report - build tmp FILE
54 .. D GETDATA(IBCNRBCI)
55 ;
56EXIT ; EN Exit point
57 Q
58 ;
59 ;
60GETDATA(IEN) ; Retrieve data for this inquiry and response(s)
61 ; Output:
62 ;
63 N GP0,LIM
64 N IBCNRBI1,IBCNRCHG,IBCNRGRP,IBCNRINS,IBCOV,IBCVRD
65 ;
66 S IBCNRBI1=$G(^DGCR(399,IBCNRBCI,"I1")) Q:$G(IBCNRBI1)=""
67 S IBCNRCHG=$P($G(^DGCR(399,IBCNRBCI,"U1")),U)
68 ; get insurance co and group
69 S IBCNRINS=$P($G(IBCNRBI1),U),IBCNRGRP=$P($G(IBCNRBI1),U,18)
70 I '$G(IBCNRINS)!'$G(IBCNRGRP) Q
71 ; chk for inactive insurance
72 I $P($G(^DIC(36,IBCNRINS,0)),U,5) Q
73 ;chk for active group
74 S GP0=$G(^IBA(355.3,IBCNRGRP,0))
75 I $P(GP0,U,11)=1 Q
76 ;chk for pharm plan coverage
77 S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
78 S LIM="",IBCVRD=0
79 F S LIM=$O(^IBA(355.32,"B",IBCNRGRP,LIM)) Q:LIM="" D
80 . I $P(^IBA(355.32,LIM,0),U,2)=IBCOV D
81 .. S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
82 I $G(IBCVRD)=0 Q
83 ;
84 I '$D(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP)) D
85 . S ^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP)="0^0"
86 S $P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)=$P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)+1
87 S $P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)=$P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)+IBCNRCHG
88 ;
89GETDATX ; GETDATA exit point
90 Q
91 ;
92 ;
Note: See TracBrowser for help on using the repository browser.