IBCNGPF2 ;ALB/CJS - LIST GRP. PLANS W/O ANNUAL BENEFITS (COMPILE) ;21-JAN-15
V ;;2.0;INTEGRATED BILLING;**528**;21-MAR-94;Build 163
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; Queued Entry Point for Report.
; Required variable input: IBAI, IBAPL, IBABY, IBAIF, IBAPF, IBOUT
; ^TMP("IBINC",$J) required if not all companies and plans selected
;
N IBABN,IBCN,IBCNS,IBEND,IBFOUND,IBI,IBIC1,IBIP1,IBSEL,IBXREF,IBGPN,IBQ3,IBQ4
;
; - compile report data
S IBI=0,IBEND=-$E($G(IBABY),1,3)_"0101"
;
K ^TMP($J,"IBGP"),^TMP($J,"IBGPL")
;
; - user wanted all companies and plans
I +$G(IBAI),+$G(IBAPL) D G PRINT
. S IBIP1=0 F S IBFOUND=0,IBIP1=$O(^IBA(355.3,IBIP1)) Q:'IBIP1 S IBIC1=$$GET1^DIQ(355.3,IBIP1,.01,"I") I +IBIC1 D I 'IBFOUND S IBGPN=$E($$GET1^DIQ(355.3,IBIP1,.01),1,25) I IBGPN]"" S ^TMP($J,"IBGPL",IBGPN,IBIC1,IBIP1)=""
. . ; - check against active/inactive selection
. . I +$$GET1^DIQ(355.3,IBIP1,.11,"I")'=$G(IBAPF) S IBFOUND=1 Q
. . I +$$GET1^DIQ(36,IBIC1,.05,"I")'=$G(IBAIF) S IBFOUND=1 Q
. . ; - traverse Annual Benefits APY cross-reference:
. . ; ^IBA(355.4,"APY",Group Insurance Plan IEN,-AB date,AB IEN)
. . S IBXREF="^IBA(355.4,""APY"","_IBIP1_")" F S IBXREF=$Q(@IBXREF) Q:(IBXREF="")!($QS(IBXREF,2)'="APY")!($QS(IBXREF,3)'=IBIP1)!($QS(IBXREF,4)>IBEND) I $QS(IBXREF,4)>-IBABY D Q:IBFOUND
. . . S IBABN=$QS(IBXREF,5) I $D(^IBA(355.4,IBABN)) D ABCHK Q
;
; - user selected companies or plans
; ^TMP("IBINC",$J,Ins. Co. Name,Ins. Co. IEN,Group Plan IEN)
S IBSEL=$NA(^TMP("IBINC",$J)) F S IBFOUND=0,IBSEL=$Q(@IBSEL) Q:(IBSEL="")!($QS(IBSEL,2)'=$J) S IBIP1=$QS(IBSEL,5) I +IBIP1 D I 'IBFOUND S IBQ3=$QS(IBSEL,3),IBQ4=$QS(IBSEL,4) I IBQ3]""&(IBQ4]"") S ^TMP($J,"IBGPL",IBQ3,IBQ4,IBIP1)=""
. ; - traverse Annual Benefits APY cross-reference:
. ; ^IBA(355.4,"APY",Group Insurance Plan IEN,-AB date,AB IEN)
. S IBXREF="^IBA(355.4,""APY"","_IBIP1_")" F S IBXREF=$Q(@IBXREF) Q:(IBXREF="")!($QS(IBXREF,2)'="APY")!($QS(IBXREF,3)'=IBIP1)!($QS(IBXREF,4)>IBEND) I $QS(IBXREF,4)>-IBABY D Q:IBFOUND
. . S IBABN=$QS(IBXREF,5) I $D(^IBA(355.4,IBABN)) D ABCHK Q
;
PRINT ; - print report
D GATH
K ^TMP("IBINC",$J)
K IBABN,IBCNS,IBEND,IBFOUND,IBI,IBIC1,IBIP1
Q
;
;
ABCHK ; Check for existing AB values
N FLD
F FLD=.05,.06 I $$GET1^DIQ(355.4,IBABN,FLD)]"" S IBFOUND=1 Q
Q:IBFOUND
F FLD=2:1:6 I $TR($G(^IBA(355.4,IBABN,FLD)),"^","")]"" S IBFOUND=1 Q
Q
;
;
GATH ; Gather all data for a company.
S IBCN="" F S IBCN=$O(^TMP($J,"IBGPL",IBCN)) Q:IBCN="" D
.S IBCNS="" F S IBCNS=$O(^TMP($J,"IBGPL",IBCN,IBCNS)) Q:'IBCNS D
..S IBI=IBI+1 D PLAN ; gather plan info
..; - set final company info
..S ^TMP($J,"IBGP",IBI)=$$COMPINF(IBCNS),^TMP($J,"IBGP")=$G(^TMP($J,"IBGP"))+1
;
K ^TMP($J,"IBGPL")
Q
;
;
COMPINF(IBCNS) ; Return formatted Insurance Company information
; Input: IBCNS -- Pointer to the insurance company in file #36
; Output: company name ^ addr ^ city/st/zip ^ phone ^ precert ^ reimburse? ^ type of coverage
;
N ACT,ADDR,CSTZ,CTYPE,NAME,PHONE,PRECERT,REIMB,ST,Z
S NAME=$$GET1^DIQ(36,IBCNS,.01)
S ADDR=$$GET1^DIQ(36,IBCNS,.111) I ADDR="" S ADDR="<Street Addr. 1 Missing>"
S Z=$$GET1^DIQ(36,IBCNS,.116)
S ST=$$GET1^DIQ(36,IBCNS,.115,"I") D
. I ST']"" S ST="<STATE MISSING>" Q
. S ST=$$GET1^DIQ(5,ST,1) I ST']"" S ST="<STATE MISSING>"
S CSTZ=$$GET1^DIQ(36,IBCNS,.114)_", "_ST_" "_$E(Z,1,5)_$S($E(Z,6,9)]"":"-"_$E(Z,6,9),1:"")
S PHONE=$$GET1^DIQ(36,IBCNS,.131)
S PRECERT=$$GET1^DIQ(36,IBCNS,.133)
S REIMB=$$GET1^DIQ(36,IBCNS,1)
S CTYPE=$$GET1^DIQ(36,IBCNS,.13)
Q NAME_U_ADDR_U_CSTZ_U_PHONE_U_PRECERT_U_REIMB_U_CTYPE
;
;
PLAN ; Gather Insurance Plan information
; Input: ^TMP($J,"IBGPL",Ins. Co. Name,Ins. Co. IEN,Plan IEN) -- Selected plans with no Annual Benefits
; IBCNS -- Pointer to the insurance company in file #36
; initialized counters
;
N IBPTR
I $G(IBCN)]"",$G(IBCNS)]"" S IBPTR=0 F S IBPTR=$O(^TMP($J,"IBGPL",IBCN,IBCNS,IBPTR)) Q:'IBPTR D
. I +$G(IBI) S ^TMP($J,"IBGP",IBI,IBPTR)=$$PLANINF(IBPTR)
Q
;
PLANINF(PLAN) ; Return formatted Insurance Plan information.
; Input: PLAN -- Pointer to the plan in file #355.3
; Output: plan name ^ number ^ act/inact ^ last edited by ^ plan type
;
N ACT,NAME,NUM,TY,USER
S NAME=$$GET1^DIQ(355.3,PLAN,2.01) S:NAME="" NAME="<NO GROUP NAME>"
S NUM=$$GET1^DIQ(355.3,PLAN,2.02) S:NUM="" NUM="<NO GROUP NUMBER>"
S ACT=$S($$GET1^DIQ(355.3,PLAN,.11,"I"):"IN",1:"")_"ACTIVE"
S USER=$$GET1^DIQ(355.3,PLAN,1.06)
S TY=$$GET1^DIQ(355.3,PLAN,.09)
Q NAME_U_NUM_U_ACT_U_USER_U_TY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNGPF2 4674 printed Nov 24, 2022@13:40:19 Page 2
IBCNGPF2 ;ALB/CJS - LIST GRP. PLANS W/O ANNUAL BENEFITS (COMPILE) ;21-JAN-15
V ;;2.0;INTEGRATED BILLING;**528**;21-MAR-94;Build 163
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 ;
EN ; Queued Entry Point for Report.
+1 ; Required variable input: IBAI, IBAPL, IBABY, IBAIF, IBAPF, IBOUT
+2 ; ^TMP("IBINC",$J) required if not all companies and plans selected
+3 ;
+4 NEW IBABN,IBCN,IBCNS,IBEND,IBFOUND,IBI,IBIC1,IBIP1,IBSEL,IBXREF,IBGPN,IBQ3,IBQ4
+5 ;
+6 ; - compile report data
+7 SET IBI=0
SET IBEND=-$EXTRACT($GET(IBABY),1,3)_"0101"
+8 ;
+9 KILL ^TMP($JOB,"IBGP"),^TMP($JOB,"IBGPL")
+10 ;
+11 ; - user wanted all companies and plans
+12 IF +$GET(IBAI)
IF +$GET(IBAPL)
Begin DoDot:1
+13 SET IBIP1=0
FOR
SET IBFOUND=0
SET IBIP1=$ORDER(^IBA(355.3,IBIP1))
if 'IBIP1
QUIT
SET IBIC1=$$GET1^DIQ(355.3,IBIP1,.01,"I")
IF +IBIC1
Begin DoDot:2
+14 ; - check against active/inactive selection
+15 IF +$$GET1^DIQ(355.3,IBIP1,.11,"I")'=$GET(IBAPF)
SET IBFOUND=1
QUIT
+16 IF +$$GET1^DIQ(36,IBIC1,.05,"I")'=$GET(IBAIF)
SET IBFOUND=1
QUIT
+17 ; - traverse Annual Benefits APY cross-reference:
+18 ; ^IBA(355.4,"APY",Group Insurance Plan IEN,-AB date,AB IEN)
+19 SET IBXREF="^IBA(355.4,""APY"","_IBIP1_")"
FOR
SET IBXREF=$QUERY(@IBXREF)
if (IBXREF="")!($QSUBSCRIPT(IBXREF,2)'="APY")!($QSUBSCRIPT(IBXREF,3)'=IBIP1)!($QSUBSCRIPT(IBXREF,4)>IBEND)
QUIT
IF $QSUBSCRIPT(IBXREF,4)>-IBABY
Begin DoDot:3
+20 SET IBABN=$QSUBSCRIPT(IBXREF,5)
IF $DATA(^IBA(355.4,IBABN))
DO ABCHK
QUIT
End DoDot:3
if IBFOUND
QUIT
End DoDot:2
IF 'IBFOUND
SET IBGPN=$EXTRACT($$GET1^DIQ(355.3,IBIP1,.01),1,25)
IF IBGPN]""
SET ^TMP($JOB,"IBGPL",IBGPN,IBIC1,IBIP1)=""
End DoDot:1
GOTO PRINT
+21 ;
+22 ; - user selected companies or plans
+23 ; ^TMP("IBINC",$J,Ins. Co. Name,Ins. Co. IEN,Group Plan IEN)
+24 SET IBSEL=$NAME(^TMP("IBINC",$JOB))
FOR
SET IBFOUND=0
SET IBSEL=$QUERY(@IBSEL)
if (IBSEL="")!($QSUBSCRIPT(IBSEL,2)'=$JOB)
QUIT
SET IBIP1=$QSUBSCRIPT(IBSEL,5)
IF +IBIP1
Begin DoDot:1
+25 ; - traverse Annual Benefits APY cross-reference:
+26 ; ^IBA(355.4,"APY",Group Insurance Plan IEN,-AB date,AB IEN)
+27 SET IBXREF="^IBA(355.4,""APY"","_IBIP1_")"
FOR
SET IBXREF=$QUERY(@IBXREF)
if (IBXREF="")!($QSUBSCRIPT(IBXREF,2)'="APY")!($QSUBSCRIPT(IBXREF,3)'=IBIP1)!($QSUBSCRIPT(IBXREF,4)>IBEND)
QUIT
IF $QSUBSCRIPT(IBXREF,4)>-IBABY
Begin DoDot:2
+28 SET IBABN=$QSUBSCRIPT(IBXREF,5)
IF $DATA(^IBA(355.4,IBABN))
DO ABCHK
QUIT
End DoDot:2
if IBFOUND
QUIT
End DoDot:1
IF 'IBFOUND
SET IBQ3=$QSUBSCRIPT(IBSEL,3)
SET IBQ4=$QSUBSCRIPT(IBSEL,4)
IF IBQ3]""&(IBQ4]"")
SET ^TMP($JOB,"IBGPL",IBQ3,IBQ4,IBIP1)=""
+29 ;
PRINT ; - print report
+1 DO GATH
+2 KILL ^TMP("IBINC",$JOB)
+3 KILL IBABN,IBCNS,IBEND,IBFOUND,IBI,IBIC1,IBIP1
+4 QUIT
+5 ;
+6 ;
ABCHK ; Check for existing AB values
+1 NEW FLD
+2 FOR FLD=.05,.06
IF $$GET1^DIQ(355.4,IBABN,FLD)]""
SET IBFOUND=1
QUIT
+3 if IBFOUND
QUIT
+4 FOR FLD=2:1:6
IF $TRANSLATE($GET(^IBA(355.4,IBABN,FLD)),"^","")]""
SET IBFOUND=1
QUIT
+5 QUIT
+6 ;
+7 ;
GATH ; Gather all data for a company.
+1 SET IBCN=""
FOR
SET IBCN=$ORDER(^TMP($JOB,"IBGPL",IBCN))
if IBCN=""
QUIT
Begin DoDot:1
+2 SET IBCNS=""
FOR
SET IBCNS=$ORDER(^TMP($JOB,"IBGPL",IBCN,IBCNS))
if 'IBCNS
QUIT
Begin DoDot:2
+3 ; gather plan info
SET IBI=IBI+1
DO PLAN
+4 ; - set final company info
+5 SET ^TMP($JOB,"IBGP",IBI)=$$COMPINF(IBCNS)
SET ^TMP($JOB,"IBGP")=$GET(^TMP($JOB,"IBGP"))+1
End DoDot:2
End DoDot:1
+6 ;
+7 KILL ^TMP($JOB,"IBGPL")
+8 QUIT
+9 ;
+10 ;
COMPINF(IBCNS) ; Return formatted Insurance Company information
+1 ; Input: IBCNS -- Pointer to the insurance company in file #36
+2 ; Output: company name ^ addr ^ city/st/zip ^ phone ^ precert ^ reimburse? ^ type of coverage
+3 ;
+4 NEW ACT,ADDR,CSTZ,CTYPE,NAME,PHONE,PRECERT,REIMB,ST,Z
+5 SET NAME=$$GET1^DIQ(36,IBCNS,.01)
+6 SET ADDR=$$GET1^DIQ(36,IBCNS,.111)
IF ADDR=""
SET ADDR="<Street Addr. 1 Missing>"
+7 SET Z=$$GET1^DIQ(36,IBCNS,.116)
+8 SET ST=$$GET1^DIQ(36,IBCNS,.115,"I")
Begin DoDot:1
+9 IF ST']""
SET ST="<STATE MISSING>"
QUIT
+10 SET ST=$$GET1^DIQ(5,ST,1)
IF ST']""
SET ST="<STATE MISSING>"
End DoDot:1
+11 SET CSTZ=$$GET1^DIQ(36,IBCNS,.114)_", "_ST_" "_$EXTRACT(Z,1,5)_$SELECT($EXTRACT(Z,6,9)]"":"-"_$EXTRACT(Z,6,9),1:"")
+12 SET PHONE=$$GET1^DIQ(36,IBCNS,.131)
+13 SET PRECERT=$$GET1^DIQ(36,IBCNS,.133)
+14 SET REIMB=$$GET1^DIQ(36,IBCNS,1)
+15 SET CTYPE=$$GET1^DIQ(36,IBCNS,.13)
+16 QUIT NAME_U_ADDR_U_CSTZ_U_PHONE_U_PRECERT_U_REIMB_U_CTYPE
+17 ;
+18 ;
PLAN ; Gather Insurance Plan information
+1 ; Input: ^TMP($J,"IBGPL",Ins. Co. Name,Ins. Co. IEN,Plan IEN) -- Selected plans with no Annual Benefits
+2 ; IBCNS -- Pointer to the insurance company in file #36
+3 ; initialized counters
+4 ;
+5 NEW IBPTR
+6 IF $GET(IBCN)]""
IF $GET(IBCNS)]""
SET IBPTR=0
FOR
SET IBPTR=$ORDER(^TMP($JOB,"IBGPL",IBCN,IBCNS,IBPTR))
if 'IBPTR
QUIT
Begin DoDot:1
+7 IF +$GET(IBI)
SET ^TMP($JOB,"IBGP",IBI,IBPTR)=$$PLANINF(IBPTR)
End DoDot:1
+8 QUIT
+9 ;
PLANINF(PLAN) ; Return formatted Insurance Plan information.
+1 ; Input: PLAN -- Pointer to the plan in file #355.3
+2 ; Output: plan name ^ number ^ act/inact ^ last edited by ^ plan type
+3 ;
+4 NEW ACT,NAME,NUM,TY,USER
+5 SET NAME=$$GET1^DIQ(355.3,PLAN,2.01)
if NAME=""
SET NAME="<NO GROUP NAME>"
+6 SET NUM=$$GET1^DIQ(355.3,PLAN,2.02)
if NUM=""
SET NUM="<NO GROUP NUMBER>"
+7 SET ACT=$SELECT($$GET1^DIQ(355.3,PLAN,.11,"I"):"IN",1:"")_"ACTIVE"
+8 SET USER=$$GET1^DIQ(355.3,PLAN,1.06)
+9 SET TY=$$GET1^DIQ(355.3,PLAN,.09)
+10 QUIT NAME_U_NUM_U_ACT_U_USER_U_TY
