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

IBCNRRP2.m

Go to the documentation of this file. 
  1. IBCNRRP2 ;DAOU/CMW - IBCNR GROUP PLAN WORKSHEET COMPILE ;03-MAR-2004
  1.  ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ; ePHARM GROUP PLAN WORKSHEET REPORT
  1.  ;
  1.  ; Input variables from IBCNRRP1:
  1.  ;   IBCNRRTN = "IBCNRRP1"
  1.  ;   IBCNRSPC("BEGDT") = Start Date for date range
  1.  ;   IBCNRSPC("ENDDT") = End Date for date range
  1.  ;   IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims
  1.  ;                      3 - Total Charges; 4 - BIN/PCN Exceptions
  1.  ; Output variables passed to IBCNRRP3:
  1.  ;   ^XTMP(IBCNRRTN)
  1.  ; Must call at EN tag
  1.  Q
  1.  ;
  1. EN(IBCNRRTN,IBCNRSPC) ; Entry point
  1.  ;
  1.  ; Initialize variables
  1.  N IBCNRDT,IBCNRDT1,IBCNRDT2,IBCNRPY,IBCNRPYR,IBCNRPTR
  1.  N IBCNRTOT,IBCNRSRT,RPTDATA,IEN,IBCNRRUN
  1.  N IBPNM,IBPIEN,ERR,PC,PYR,IBCNRBCI
  1.  ;
  1.  I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
  1.  ;
  1.  ; Total responses selected
  1.  S IBCNRTOT=0
  1.  ;
  1.  ; Kill scratch global
  1.  K ^XTMP(IBCNRRTN)
  1.  ;
  1.  ; Initialize looping variables
  1.  S IBCNRDT2=$G(IBCNRSPC("ENDDT"))
  1.  S IBCNRDT1=$G(IBCNRSPC("BEGDT"))
  1.  S IBCNRSRT=$G(IBCNRSPC("SORT"))
  1.  S IBCNRRUN=$$HTE^XLFDT($H,1)
  1.  S ^XTMP(IBCNRRTN,0)=DT_U_(DT+10000)_U_"Scratch Global for IBCNR GROUP PLAN WORKSHEET report"
  1.  S ^XTMP(IBCNRRTN,0,0)=IBCNRDT1_"^"_IBCNRDT2_"^"_IBCNRRUN
  1.  ;
  1.  ; Loop through the Bill/Claims file 
  1.  ;  Authorization Date Cross-Reference
  1.  ; xref APD3 - Authorized Claims only
  1.  ; xref APD - All entered Claims
  1.  S IBCNRDT=$O(^DGCR(399,"APD3",IBCNRDT1),-1)
  1.  F  S IBCNRDT=$O(^DGCR(399,"APD3",IBCNRDT)) Q:IBCNRDT=""!($P(IBCNRDT,".",1)>IBCNRDT2)  D  Q:$G(ZTSTOP)
  1.  . S IBCNRBCI=0
  1.  . F  S IBCNRBCI=$O(^DGCR(399,"APD3",IBCNRDT,IBCNRBCI)) Q:'IBCNRBCI  D  Q:$G(ZTSTOP)
  1.  .. ; Update selected count
  1.  .. S IBCNRTOT=IBCNRTOT+1
  1.  .. ;I $D(ZTQUEUED),IBCNRTOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
  1.  .. ;
  1.  .. ; Now get the data for the report - build tmp FILE
  1.  .. D GETDATA(IBCNRBCI)
  1.  ;
  1. EXIT ; EN Exit point
  1.  Q
  1.  ;
  1.  ;
  1. GETDATA(IEN) ; Retrieve data for this inquiry and response(s)
  1.  ; Output: 
  1.  ;  
  1.  N GP0,LIM
  1.  N IBCNRBI1,IBCNRCHG,IBCNRGRP,IBCNRINS,IBCOV,IBCVRD
  1.  ;
  1.  S IBCNRBI1=$G(^DGCR(399,IBCNRBCI,"I1")) Q:$G(IBCNRBI1)=""
  1.  S IBCNRCHG=$P($G(^DGCR(399,IBCNRBCI,"U1")),U)
  1.  ; get insurance co and group
  1.  S IBCNRINS=$P($G(IBCNRBI1),U),IBCNRGRP=$P($G(IBCNRBI1),U,18)
  1.  I '$G(IBCNRINS)!'$G(IBCNRGRP) Q
  1.  ; chk for inactive insurance
  1.  I $P($G(^DIC(36,IBCNRINS,0)),U,5) Q
  1.  ;chk for active group
  1.  S GP0=$G(^IBA(355.3,IBCNRGRP,0))
  1.  I $P(GP0,U,11)=1 Q
  1.  ;chk for pharm plan coverage
  1.  S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
  1.  S LIM="",IBCVRD=0
  1.  F  S LIM=$O(^IBA(355.32,"B",IBCNRGRP,LIM)) Q:LIM=""  D
  1.  . I $P(^IBA(355.32,LIM,0),U,2)=IBCOV D
  1.  .. S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
  1.  I $G(IBCVRD)=0 Q
  1.  ;
  1.  I '$D(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP)) D
  1.  . S ^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP)="0^0"
  1.  S $P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)=$P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)+1
  1.  S $P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)=$P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)+IBCNRCHG
  1.  ;
  1. GETDATX ; GETDATA exit point
  1.  Q
  1.  ;
  1.  ;