- 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 Mar 13, 2025@21:18:25 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 ;
