IBCNRRP2 ;DAOU/CMW - IBCNR GROUP PLAN WORKSHEET COMPILE ;03-MAR-2004
;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; ePHARM GROUP PLAN WORKSHEET REPORT
;
; Input variables from IBCNRRP1:
; IBCNRRTN = "IBCNRRP1"
; IBCNRSPC("BEGDT") = Start Date for date range
; IBCNRSPC("ENDDT") = End Date for date range
; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims
; 3 - Total Charges; 4 - BIN/PCN Exceptions
; Output variables passed to IBCNRRP3:
; ^XTMP(IBCNRRTN)
; Must call at EN tag
Q
;
EN(IBCNRRTN,IBCNRSPC) ; Entry point
;
; Initialize variables
N IBCNRDT,IBCNRDT1,IBCNRDT2,IBCNRPY,IBCNRPYR,IBCNRPTR
N IBCNRTOT,IBCNRSRT,RPTDATA,IEN,IBCNRRUN
N IBPNM,IBPIEN,ERR,PC,PYR,IBCNRBCI
;
I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
;
; Total responses selected
S IBCNRTOT=0
;
; Kill scratch global
K ^XTMP(IBCNRRTN)
;
; Initialize looping variables
S IBCNRDT2=$G(IBCNRSPC("ENDDT"))
S IBCNRDT1=$G(IBCNRSPC("BEGDT"))
S IBCNRSRT=$G(IBCNRSPC("SORT"))
S IBCNRRUN=$$HTE^XLFDT($H,1)
S ^XTMP(IBCNRRTN,0)=DT_U_(DT+10000)_U_"Scratch Global for IBCNR GROUP PLAN WORKSHEET report"
S ^XTMP(IBCNRRTN,0,0)=IBCNRDT1_"^"_IBCNRDT2_"^"_IBCNRRUN
;
; Loop through the Bill/Claims file
; Authorization Date Cross-Reference
; xref APD3 - Authorized Claims only
; xref APD - All entered Claims
S IBCNRDT=$O(^DGCR(399,"APD3",IBCNRDT1),-1)
F S IBCNRDT=$O(^DGCR(399,"APD3",IBCNRDT)) Q:IBCNRDT=""!($P(IBCNRDT,".",1)>IBCNRDT2) D Q:$G(ZTSTOP)
. S IBCNRBCI=0
. F S IBCNRBCI=$O(^DGCR(399,"APD3",IBCNRDT,IBCNRBCI)) Q:'IBCNRBCI D Q:$G(ZTSTOP)
.. ; Update selected count
.. S IBCNRTOT=IBCNRTOT+1
.. ;I $D(ZTQUEUED),IBCNRTOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
.. ;
.. ; Now get the data for the report - build tmp FILE
.. D GETDATA(IBCNRBCI)
;
EXIT ; EN Exit point
Q
;
;
GETDATA(IEN) ; Retrieve data for this inquiry and response(s)
; Output:
;
N GP0,LIM
N IBCNRBI1,IBCNRCHG,IBCNRGRP,IBCNRINS,IBCOV,IBCVRD
;
S IBCNRBI1=$G(^DGCR(399,IBCNRBCI,"I1")) Q:$G(IBCNRBI1)=""
S IBCNRCHG=$P($G(^DGCR(399,IBCNRBCI,"U1")),U)
; get insurance co and group
S IBCNRINS=$P($G(IBCNRBI1),U),IBCNRGRP=$P($G(IBCNRBI1),U,18)
I '$G(IBCNRINS)!'$G(IBCNRGRP) Q
; chk for inactive insurance
I $P($G(^DIC(36,IBCNRINS,0)),U,5) Q
;chk for active group
S GP0=$G(^IBA(355.3,IBCNRGRP,0))
I $P(GP0,U,11)=1 Q
;chk for pharm plan coverage
S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
S LIM="",IBCVRD=0
F S LIM=$O(^IBA(355.32,"B",IBCNRGRP,LIM)) Q:LIM="" D
. I $P(^IBA(355.32,LIM,0),U,2)=IBCOV D
.. S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
I $G(IBCVRD)=0 Q
;
I '$D(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP)) D
. S ^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP)="0^0"
S $P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)=$P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)+1
S $P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)=$P(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)+IBCNRCHG
;
GETDATX ; GETDATA exit point
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRRP2 3089 printed Apr 09, 2024@21:18:24 Page 2
IBCNRRP2 ;DAOU/CMW - IBCNR GROUP PLAN WORKSHEET COMPILE ;03-MAR-2004
+1 ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; ePHARM GROUP PLAN WORKSHEET REPORT
+5 ;
+6 ; Input variables from IBCNRRP1:
+7 ; IBCNRRTN = "IBCNRRP1"
+8 ; IBCNRSPC("BEGDT") = Start Date for date range
+9 ; IBCNRSPC("ENDDT") = End Date for date range
+10 ; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims
+11 ; 3 - Total Charges; 4 - BIN/PCN Exceptions
+12 ; Output variables passed to IBCNRRP3:
+13 ; ^XTMP(IBCNRRTN)
+14 ; Must call at EN tag
+15 QUIT
+16 ;
EN(IBCNRRTN,IBCNRSPC) ; Entry point
+1 ;
+2 ; Initialize variables
+3 NEW IBCNRDT,IBCNRDT1,IBCNRDT2,IBCNRPY,IBCNRPYR,IBCNRPTR
+4 NEW IBCNRTOT,IBCNRSRT,RPTDATA,IEN,IBCNRRUN
+5 NEW IBPNM,IBPIEN,ERR,PC,PYR,IBCNRBCI
+6 ;
+7 IF '$DATA(ZTQUEUED)
IF $GET(IOST)["C-"
WRITE !!,"Compiling report data ..."
+8 ;
+9 ; Total responses selected
+10 SET IBCNRTOT=0
+11 ;
+12 ; Kill scratch global
+13 KILL ^XTMP(IBCNRRTN)
+14 ;
+15 ; Initialize looping variables
+16 SET IBCNRDT2=$GET(IBCNRSPC("ENDDT"))
+17 SET IBCNRDT1=$GET(IBCNRSPC("BEGDT"))
+18 SET IBCNRSRT=$GET(IBCNRSPC("SORT"))
+19 SET IBCNRRUN=$$HTE^XLFDT($HOROLOG,1)
+20 SET ^XTMP(IBCNRRTN,0)=DT_U_(DT+10000)_U_"Scratch Global for IBCNR GROUP PLAN WORKSHEET report"
+21 SET ^XTMP(IBCNRRTN,0,0)=IBCNRDT1_"^"_IBCNRDT2_"^"_IBCNRRUN
+22 ;
+23 ; Loop through the Bill/Claims file
+24 ; Authorization Date Cross-Reference
+25 ; xref APD3 - Authorized Claims only
+26 ; xref APD - All entered Claims
+27 SET IBCNRDT=$ORDER(^DGCR(399,"APD3",IBCNRDT1),-1)
+28 FOR
SET IBCNRDT=$ORDER(^DGCR(399,"APD3",IBCNRDT))
if IBCNRDT=""!($PIECE(IBCNRDT,".",1)>IBCNRDT2)
QUIT
Begin DoDot:1
+29 SET IBCNRBCI=0
+30 FOR
SET IBCNRBCI=$ORDER(^DGCR(399,"APD3",IBCNRDT,IBCNRBCI))
if 'IBCNRBCI
QUIT
Begin DoDot:2
+31 ; Update selected count
+32 SET IBCNRTOT=IBCNRTOT+1
+33 ;I $D(ZTQUEUED),IBCNRTOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
+34 ;
+35 ; Now get the data for the report - build tmp FILE
+36 DO GETDATA(IBCNRBCI)
End DoDot:2
if $GET(ZTSTOP)
QUIT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+37 ;
EXIT ; EN Exit point
+1 QUIT
+2 ;
+3 ;
GETDATA(IEN) ; Retrieve data for this inquiry and response(s)
+1 ; Output:
+2 ;
+3 NEW GP0,LIM
+4 NEW IBCNRBI1,IBCNRCHG,IBCNRGRP,IBCNRINS,IBCOV,IBCVRD
+5 ;
+6 SET IBCNRBI1=$GET(^DGCR(399,IBCNRBCI,"I1"))
if $GET(IBCNRBI1)=""
QUIT
+7 SET IBCNRCHG=$PIECE($GET(^DGCR(399,IBCNRBCI,"U1")),U)
+8 ; get insurance co and group
+9 SET IBCNRINS=$PIECE($GET(IBCNRBI1),U)
SET IBCNRGRP=$PIECE($GET(IBCNRBI1),U,18)
+10 IF '$GET(IBCNRINS)!'$GET(IBCNRGRP)
QUIT
+11 ; chk for inactive insurance
+12 IF $PIECE($GET(^DIC(36,IBCNRINS,0)),U,5)
QUIT
+13 ;chk for active group
+14 SET GP0=$GET(^IBA(355.3,IBCNRGRP,0))
+15 IF $PIECE(GP0,U,11)=1
QUIT
+16 ;chk for pharm plan coverage
+17 SET IBCOV=$ORDER(^IBE(355.31,"B","PHARMACY",""))
+18 SET LIM=""
SET IBCVRD=0
+19 FOR
SET LIM=$ORDER(^IBA(355.32,"B",IBCNRGRP,LIM))
if LIM=""
QUIT
Begin DoDot:1
+20 IF $PIECE(^IBA(355.32,LIM,0),U,2)=IBCOV
Begin DoDot:2
+21 SET IBCVRD=$PIECE(^IBA(355.32,LIM,0),U,4)
End DoDot:2
End DoDot:1
+22 IF $GET(IBCVRD)=0
QUIT
+23 ;
+24 IF '$DATA(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP))
Begin DoDot:1
+25 SET ^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP)="0^0"
End DoDot:1
+26 SET $PIECE(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)=$PIECE(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U)+1
+27 SET $PIECE(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)=$PIECE(^XTMP(IBCNRRTN,IBCNRINS,IBCNRGRP),U,2)+IBCNRCHG
+28 ;
GETDATX ; GETDATA exit point
+1 QUIT
+2 ;
+3 ;
