IBCMDT2 ;ALB/VD - INSURANCE PLANS MISSING DATA REPORT (COMPILE) ; 10-APR-15
;;2.0;INTEGRATED BILLING ;**549**; 10-APR-15;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; Queued Entry Point for Report.
; Required variable input: FLTRS,IBAI, IBAPL, IBGRN, IBPTY, IBTFT, IBEPT,
; IBCLM, IBBIN, IBNMSPC,IBPCN
; ^TMP("IBCMDT",IBNMSPC) required if all companies and plans not selected
;
; - compile report data
N IBI,IBIC1,IBCNS
S IBI=0 K ^TMP($J,"PR")
S IBIC1=""
F S IBIC1=$O(^TMP("IBCMDT",IBNMSPC,IBIC1)) Q:IBIC1="" D
. S IBCNS=0
. F S IBCNS=$O(^TMP("IBCMDT",IBNMSPC,IBIC1,IBCNS)) Q:'IBCNS D
. . D GATH
Q
;
GATH ; Gather all data for a company.
N IBCPS,IBCPT,IBCST
S IBI=IBI+1,(IBCPT,IBCPS,IBCST)=0 ; initialize counters
D PLAN ; gather plan info
;
; - set final company info
S ^TMP($J,"PR",IBI)=$$COMPINF(IBCNS)_"^"_IBCPT_"^"_IBCPS
Q
;
PLAN ; Gather Insurance Plan information, if necessary
; Input: IBCNS -- Pointer to the insurance company in file #36
; initialized counters, plus the 'Plan' array (^TMP("IBINC",$J))
;
N FNDONE,IBPTR,PLNDATA,POSWT
S IBPTR=0
S POSWT=$S($$GET1^DIQ(36,IBCNS,.13)="PRESCRIPTION ONLY":1,1:0)
F S IBPTR=$O(^IBA(355.3,"B",IBCNS,IBPTR)) Q:'IBPTR D
. S PLNDATA=$$PLANINF(IBPTR,POSWT)
. Q:(+PLNDATA=-2) ; Skip inactive plans.
. ;
. ; If there's no Missing Plan Data & not looking for coverage limitations.
. I (+PLNDATA=-1),'+$G(IBMDTSPC("IBCLM")) Q
. S ^TMP($J,"PR",IBI,IBPTR)=PLNDATA
. I +$G(IBMDTSPC("IBCLM")) D
. . S FNDONE=+$$GCVLIMS(IBI,IBPTR,1) ; This will create the cov. limit. nodes
. . ;
. . ; No missing coverage limitations AND no other missing data on requested
. . ; Filters found, kill reference to the plan.
. . I '+FNDONE,+PLNDATA=-1 K ^TMP($J,"PR",IBI,IBPTR)
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
;
N POSWT,ST,X
S POSWT=$S($$GET1^DIQ(36,IBCNS,.13)="PRESCRIPTION ONLY":1,1:0)
S ST=$P($G(^DIC(5,+$$GET1^DIQ(36,IBCNS,.115,"I"),0)),U,2)
S X=POSWT_U_$$GET1^DIQ(36,IBCNS,.01)_U_$$GET1^DIQ(36,IBCNS,.111)
S X=X_U_$$GET1^DIQ(36,IBCNS,.114)_", "_ST_" "_$$GET1^DIQ(36,IBCNS,.116)
Q X
;
PLANINF(PLAN,POSWT) ; Return formatted Insurance Plan information.
; Input: PLAN - Pointer to the plan in file #355.3
; POSWT - PRESCRIPTION ONLY indicator
; Returns: A1^A2^A3^...^A8 Where
; A1 - -2 if inactive plan, -1 if no missing data found, else 0
; A2 - Plan Number
; A3 - Plan Name
; A4 - Type of Plan (Group or Individual
; A5 - Electronic Plan Type
; A6 - Timely filing Time Frame
; A7 - Banking Identification Number
; A8 - Process Control Number
;
N BIN,EPT,NAME,NUM,PCN,TFTF,TYP,VAL
S VAL=-2
I +$$GET1^DIQ(355.3,+PLAN,.11,"I") Q VAL ; INACTIVE Plan, skip
S VAL=-1
S NAME=$E($$GET1^DIQ(355.3,+PLAN,.03),1,45) ; 45 Chars max
S NUM=$$GET1^DIQ(355.3,+PLAN,.04) ; 17 Chars max
S:'$L(NUM) NUM="#######"
I +$G(IBMDTSPC("IBGRN")),NUM="#######" S VAL=0 ; Found Missing data for a Filter
S TYP=$$GET1^DIQ(355.3,+PLAN,.09) ; 40 Chars max
S:'$L(TYP) TYP="#######"
I +$G(IBMDTSPC("IBPTY")),TYP="#######" S VAL=0 ; Found Missing data for a Filter
S EPT=$$GET1^DIQ(355.3,+PLAN,.15) ; 26 Chars max
S:'$L(EPT) EPT="#######"
I +$G(IBMDTSPC("IBEPT")),EPT="#######" S VAL=0 ; Found Missing data for a Filter
S TFTF=$$FTFGP^IBCNEUT7(PLAN,1) ; Around 30 Chars max
I +$G(IBMDTSPC("IBTFT")),TFTF["###" S VAL=0 ; Found Missing data for a Filter
S BIN=$$GET1^DIQ(355.3,+PLAN,6.02) ; 10 Chars max
;
; If the plan is Prescription Only AND the Banking Identifier is blank, indicate it
I +POSWT,'$L(BIN) S BIN="#######"
I +$G(IBMDTSPC("IBBIN")),+POSWT,BIN="#######" S VAL=0 ; Found Missing data for a Filter
S PCN=$$GET1^DIQ(355.3,+PLAN,6.03) ; 20 Chars max
;
; If the plan is Prescription Only AND the Process Control Number is blank, indicate it
I +POSWT,'$L(PCN) S PCN="#######"
I +$G(IBMDTSPC("IBPCN")),+POSWT,PCN="#######" S VAL=0 ; Found Missing data for a Filter
Q VAL_U_NUM_U_$E(NAME,1,12)_U_$E(TYP,1,12)_U_$E(EPT,1,12)_U_TFTF_U_BIN_U_PCN
;
GCVLIMS(IBI,PLAN,RECIND) ; Obtain Plans that may have Coverage Limits missing.
; Input: IBI -- Line counter
; IBCNS -- Pointer to the insurance company in file #36
; RECIND -- Indicator to determine if header record for plan is already set
; 0 means ^TMP($J,"PR",IBI,IBPTR) is already set.
; 1 means ^TMP($J,"PR",IBI,IBPTR) is not set yet.
; Output: This will create the ^TMP($J,"PR",IBI,IBPTR,IBCVLM) node
; FOUND -- 0 means a missing data coverage limitation was not found.
; 1 means a missing data coverage limitation was found.
;
N FOUND,IBCAT,IBCOV,IBCPTR,IBCSTA,IBCVDAT,IBEFDT,IBRECDT,IBRECN,IBREC,VAL
S (FOUND,IBCPTR)=0
I '$D(^IBA(355.32,"APCD",PLAN)) D Q +FOUND
. I '+$G(IBMDTSPC("IBCLM")) Q
. S FOUND=1,IBCPTR=IBCPTR+1
. S ^TMP($J,"PR",IBI,IBPTR,IBCPTR)="This plan has no coverage limitations defined."
S IBCAT=0
F S IBCAT=$O(^IBE(355.31,IBCAT)) Q:'+IBCAT D
. I '$D(^IBA(355.32,"APCD",PLAN,IBCAT)) D Q
. . S IBCOV=$$GET1^DIQ(355.31,IBCAT,.01)
. . S IBEFDT="#######",IBCSTA="#######"
. . S IBCVDAT=IBCOV_U_IBEFDT_U_IBCSTA,FOUND=1
. . S IBCPTR=IBCPTR+1
. . S ^TMP($J,"PR",IBI,IBPTR,IBCPTR)=IBCVDAT
F S IBCAT=$O(^IBA(355.32,"APCD",PLAN,IBCAT)) Q:IBCAT="" D
. S IBRECDT=""
. F S IBRECDT=$O(^IBA(355.32,"APCD",PLAN,IBCAT,IBRECDT)) Q:IBRECDT="" D
. . S IBRECN=""
. . F S IBRECN=$O(^IBA(355.32,"APCD",PLAN,IBCAT,IBRECDT,IBRECN)) Q:IBRECN="" D
. . . S IBEFDT=$$DAT1^IBOUTL($$GET1^DIQ(355.32,IBRECN,.03,"I"))
. . . I +$G(IBMDTSPC("IBCLM")) S IBEFDT=$S(+$L(IBEFDT):IBEFDT,1:"#######") ; Effective Date
. . . S IBCOV=$$GET1^DIQ(355.32,IBRECN,.02)
. . . I +$G(IBMDTSPC("IBCLM")) S IBCOV=$S(+$L(IBCOV):IBCOV,1:"#######") ; Coverage Category
. . . S IBCSTA=$$GET1^DIQ(355.32,IBRECN,.04)
. . . I +$G(IBMDTSPC("IBCLM")) S IBCSTA=$S(+$L(IBCSTA):IBCSTA,1:"#######") ; Coverage Status
. . . S IBCVDAT=IBCOV_U_IBEFDT_U_IBCSTA
. . . I IBCVDAT["#######" S FOUND=1
. . . S IBCPTR=IBCPTR+1
. . . I +FOUND S ^TMP($J,"PR",IBI,IBPTR,IBCPTR)=IBCVDAT
Q +FOUND
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCMDT2 6622 printed Nov 22, 2024@17:23:41 Page 2
IBCMDT2 ;ALB/VD - INSURANCE PLANS MISSING DATA REPORT (COMPILE) ; 10-APR-15
+1 ;;2.0;INTEGRATED BILLING ;**549**; 10-APR-15;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Queued Entry Point for Report.
+1 ; Required variable input: FLTRS,IBAI, IBAPL, IBGRN, IBPTY, IBTFT, IBEPT,
+2 ; IBCLM, IBBIN, IBNMSPC,IBPCN
+3 ; ^TMP("IBCMDT",IBNMSPC) required if all companies and plans not selected
+4 ;
+5 ; - compile report data
+6 NEW IBI,IBIC1,IBCNS
+7 SET IBI=0
KILL ^TMP($JOB,"PR")
+8 SET IBIC1=""
+9 FOR
SET IBIC1=$ORDER(^TMP("IBCMDT",IBNMSPC,IBIC1))
if IBIC1=""
QUIT
Begin DoDot:1
+10 SET IBCNS=0
+11 FOR
SET IBCNS=$ORDER(^TMP("IBCMDT",IBNMSPC,IBIC1,IBCNS))
if 'IBCNS
QUIT
Begin DoDot:2
+12 DO GATH
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
GATH ; Gather all data for a company.
+1 NEW IBCPS,IBCPT,IBCST
+2 ; initialize counters
SET IBI=IBI+1
SET (IBCPT,IBCPS,IBCST)=0
+3 ; gather plan info
DO PLAN
+4 ;
+5 ; - set final company info
+6 SET ^TMP($JOB,"PR",IBI)=$$COMPINF(IBCNS)_"^"_IBCPT_"^"_IBCPS
+7 QUIT
+8 ;
PLAN ; Gather Insurance Plan information, if necessary
+1 ; Input: IBCNS -- Pointer to the insurance company in file #36
+2 ; initialized counters, plus the 'Plan' array (^TMP("IBINC",$J))
+3 ;
+4 NEW FNDONE,IBPTR,PLNDATA,POSWT
+5 SET IBPTR=0
+6 SET POSWT=$SELECT($$GET1^DIQ(36,IBCNS,.13)="PRESCRIPTION ONLY":1,1:0)
+7 FOR
SET IBPTR=$ORDER(^IBA(355.3,"B",IBCNS,IBPTR))
if 'IBPTR
QUIT
Begin DoDot:1
+8 SET PLNDATA=$$PLANINF(IBPTR,POSWT)
+9 ; Skip inactive plans.
if (+PLNDATA=-2)
QUIT
+10 ;
+11 ; If there's no Missing Plan Data & not looking for coverage limitations.
+12 IF (+PLNDATA=-1)
IF '+$GET(IBMDTSPC("IBCLM"))
QUIT
+13 SET ^TMP($JOB,"PR",IBI,IBPTR)=PLNDATA
+14 IF +$GET(IBMDTSPC("IBCLM"))
Begin DoDot:2
+15 ; This will create the cov. limit. nodes
SET FNDONE=+$$GCVLIMS(IBI,IBPTR,1)
+16 ;
+17 ; No missing coverage limitations AND no other missing data on requested
+18 ; Filters found, kill reference to the plan.
+19 IF '+FNDONE
IF +PLNDATA=-1
KILL ^TMP($JOB,"PR",IBI,IBPTR)
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
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
+3 ;
+4 NEW POSWT,ST,X
+5 SET POSWT=$SELECT($$GET1^DIQ(36,IBCNS,.13)="PRESCRIPTION ONLY":1,1:0)
+6 SET ST=$PIECE($GET(^DIC(5,+$$GET1^DIQ(36,IBCNS,.115,"I"),0)),U,2)
+7 SET X=POSWT_U_$$GET1^DIQ(36,IBCNS,.01)_U_$$GET1^DIQ(36,IBCNS,.111)
+8 SET X=X_U_$$GET1^DIQ(36,IBCNS,.114)_", "_ST_" "_$$GET1^DIQ(36,IBCNS,.116)
+9 QUIT X
+10 ;
PLANINF(PLAN,POSWT) ; Return formatted Insurance Plan information.
+1 ; Input: PLAN - Pointer to the plan in file #355.3
+2 ; POSWT - PRESCRIPTION ONLY indicator
+3 ; Returns: A1^A2^A3^...^A8 Where
+4 ; A1 - -2 if inactive plan, -1 if no missing data found, else 0
+5 ; A2 - Plan Number
+6 ; A3 - Plan Name
+7 ; A4 - Type of Plan (Group or Individual
+8 ; A5 - Electronic Plan Type
+9 ; A6 - Timely filing Time Frame
+10 ; A7 - Banking Identification Number
+11 ; A8 - Process Control Number
+12 ;
+13 NEW BIN,EPT,NAME,NUM,PCN,TFTF,TYP,VAL
+14 SET VAL=-2
+15 ; INACTIVE Plan, skip
IF +$$GET1^DIQ(355.3,+PLAN,.11,"I")
QUIT VAL
+16 SET VAL=-1
+17 ; 45 Chars max
SET NAME=$EXTRACT($$GET1^DIQ(355.3,+PLAN,.03),1,45)
+18 ; 17 Chars max
SET NUM=$$GET1^DIQ(355.3,+PLAN,.04)
+19 if '$LENGTH(NUM)
SET NUM="#######"
+20 ; Found Missing data for a Filter
IF +$GET(IBMDTSPC("IBGRN"))
IF NUM="#######"
SET VAL=0
+21 ; 40 Chars max
SET TYP=$$GET1^DIQ(355.3,+PLAN,.09)
+22 if '$LENGTH(TYP)
SET TYP="#######"
+23 ; Found Missing data for a Filter
IF +$GET(IBMDTSPC("IBPTY"))
IF TYP="#######"
SET VAL=0
+24 ; 26 Chars max
SET EPT=$$GET1^DIQ(355.3,+PLAN,.15)
+25 if '$LENGTH(EPT)
SET EPT="#######"
+26 ; Found Missing data for a Filter
IF +$GET(IBMDTSPC("IBEPT"))
IF EPT="#######"
SET VAL=0
+27 ; Around 30 Chars max
SET TFTF=$$FTFGP^IBCNEUT7(PLAN,1)
+28 ; Found Missing data for a Filter
IF +$GET(IBMDTSPC("IBTFT"))
IF TFTF["###"
SET VAL=0
+29 ; 10 Chars max
SET BIN=$$GET1^DIQ(355.3,+PLAN,6.02)
+30 ;
+31 ; If the plan is Prescription Only AND the Banking Identifier is blank, indicate it
+32 IF +POSWT
IF '$LENGTH(BIN)
SET BIN="#######"
+33 ; Found Missing data for a Filter
IF +$GET(IBMDTSPC("IBBIN"))
IF +POSWT
IF BIN="#######"
SET VAL=0
+34 ; 20 Chars max
SET PCN=$$GET1^DIQ(355.3,+PLAN,6.03)
+35 ;
+36 ; If the plan is Prescription Only AND the Process Control Number is blank, indicate it
+37 IF +POSWT
IF '$LENGTH(PCN)
SET PCN="#######"
+38 ; Found Missing data for a Filter
IF +$GET(IBMDTSPC("IBPCN"))
IF +POSWT
IF PCN="#######"
SET VAL=0
+39 QUIT VAL_U_NUM_U_$EXTRACT(NAME,1,12)_U_$EXTRACT(TYP,1,12)_U_$EXTRACT(EPT,1,12)_U_TFTF_U_BIN_U_PCN
+40 ;
GCVLIMS(IBI,PLAN,RECIND) ; Obtain Plans that may have Coverage Limits missing.
+1 ; Input: IBI -- Line counter
+2 ; IBCNS -- Pointer to the insurance company in file #36
+3 ; RECIND -- Indicator to determine if header record for plan is already set
+4 ; 0 means ^TMP($J,"PR",IBI,IBPTR) is already set.
+5 ; 1 means ^TMP($J,"PR",IBI,IBPTR) is not set yet.
+6 ; Output: This will create the ^TMP($J,"PR",IBI,IBPTR,IBCVLM) node
+7 ; FOUND -- 0 means a missing data coverage limitation was not found.
+8 ; 1 means a missing data coverage limitation was found.
+9 ;
+10 NEW FOUND,IBCAT,IBCOV,IBCPTR,IBCSTA,IBCVDAT,IBEFDT,IBRECDT,IBRECN,IBREC,VAL
+11 SET (FOUND,IBCPTR)=0
+12 IF '$DATA(^IBA(355.32,"APCD",PLAN))
Begin DoDot:1
+13 IF '+$GET(IBMDTSPC("IBCLM"))
QUIT
+14 SET FOUND=1
SET IBCPTR=IBCPTR+1
+15 SET ^TMP($JOB,"PR",IBI,IBPTR,IBCPTR)="This plan has no coverage limitations defined."
End DoDot:1
QUIT +FOUND
+16 SET IBCAT=0
+17 FOR
SET IBCAT=$ORDER(^IBE(355.31,IBCAT))
if '+IBCAT
QUIT
Begin DoDot:1
+18 IF '$DATA(^IBA(355.32,"APCD",PLAN,IBCAT))
Begin DoDot:2
+19 SET IBCOV=$$GET1^DIQ(355.31,IBCAT,.01)
+20 SET IBEFDT="#######"
SET IBCSTA="#######"
+21 SET IBCVDAT=IBCOV_U_IBEFDT_U_IBCSTA
SET FOUND=1
+22 SET IBCPTR=IBCPTR+1
+23 SET ^TMP($JOB,"PR",IBI,IBPTR,IBCPTR)=IBCVDAT
End DoDot:2
QUIT
End DoDot:1
+24 FOR
SET IBCAT=$ORDER(^IBA(355.32,"APCD",PLAN,IBCAT))
if IBCAT=""
QUIT
Begin DoDot:1
+25 SET IBRECDT=""
+26 FOR
SET IBRECDT=$ORDER(^IBA(355.32,"APCD",PLAN,IBCAT,IBRECDT))
if IBRECDT=""
QUIT
Begin DoDot:2
+27 SET IBRECN=""
+28 FOR
SET IBRECN=$ORDER(^IBA(355.32,"APCD",PLAN,IBCAT,IBRECDT,IBRECN))
if IBRECN=""
QUIT
Begin DoDot:3
+29 SET IBEFDT=$$DAT1^IBOUTL($$GET1^DIQ(355.32,IBRECN,.03,"I"))
+30 ; Effective Date
IF +$GET(IBMDTSPC("IBCLM"))
SET IBEFDT=$SELECT(+$LENGTH(IBEFDT):IBEFDT,1:"#######")
+31 SET IBCOV=$$GET1^DIQ(355.32,IBRECN,.02)
+32 ; Coverage Category
IF +$GET(IBMDTSPC("IBCLM"))
SET IBCOV=$SELECT(+$LENGTH(IBCOV):IBCOV,1:"#######")
+33 SET IBCSTA=$$GET1^DIQ(355.32,IBRECN,.04)
+34 ; Coverage Status
IF +$GET(IBMDTSPC("IBCLM"))
SET IBCSTA=$SELECT(+$LENGTH(IBCSTA):IBCSTA,1:"#######")
+35 SET IBCVDAT=IBCOV_U_IBEFDT_U_IBCSTA
+36 IF IBCVDAT["#######"
SET FOUND=1
+37 SET IBCPTR=IBCPTR+1
+38 IF +FOUND
SET ^TMP($JOB,"PR",IBI,IBPTR,IBCPTR)=IBCVDAT
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT +FOUND
+40 ;
