- IBCOPP2 ;ALB/NLR - LIST INS. PLANS BY CO. (COMPILE) ; 20-OCT-2015
- ;;2.0;INTEGRATED BILLING;**28,62,93,516,528,549**;21-MAR-94;Build 54
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- EN ; Queued Entry Point for Report.
- ; Input: IBAI - 0 - User selected Insurance Companies
- ; 1 - Run report for all Insurance Companies with Plans
- ; IBAIA - 0 - Only select Inactive Insurance Companies
- ; 1 - Only select Active Insurance Companies
- ; 2 - Select both Active and Inactive Insurance Companies
- ; IBAIPA 0 - Only select Inactive Insurance Company Plans
- ; 1 - Only select Active Insurance Company Plans
- ; 2 - Select both Active and Inactive Insurance Company Plans
- ; IBAO= E - Output to Excel
- ; R - Report
- ; IBAPA - 0 - List Insurance Plans by Insurance Company
- ; 1 - List Insurance Plans by Insurance Company
- ; with Subscriber information
- ; IBAPA - 0 - List Insurance Plans by Insurance Company
- ; 1 - List Insurance Plans by Insurance Company with Subscriber
- ; information
- ; IBAPL - 0 - User selected Group Plans
- ; 1 - Run report for all Group Plans for each Ins. Co
- ; NOTE: only used if IBAI=1, otherwise, some Insurance
- ; companies may select all Group Plans and some
- ; may be use selected Group Plans
- ; ^TMP("IBINC",$J,IBIC,IBCNS,IBPTR)="" - Selected Ins Cos/Plans
- ; Required if all Insurance Companies and all Group Plans
- ; not selected Where:
- ; IBIC - Insurance Company Name
- ; IBCNS - IEN of the selected Insurance Company, file 36
- ; IBPTR - IEN of the selected Group Plan, file 355.3
- ;
- ; Compile report data
- N GIEN,XX
- S IBI=0
- K ^TMP($J,"PR"),^TMP($J,"PL")
- ;
- ; Display all Insurance Companies and all Group Plans
- I IBAI,IBAPL D
- . S IBIC1=""
- . F S IBIC1=$O(^DIC(36,"B",IBIC1)) Q:IBIC1="" D
- . . S IBCNS=0
- . . F S IBCNS=$O(^DIC(36,"B",IBIC1,IBCNS)) Q:'IBCNS D
- . . . I $D(^IBA(355.3,"B",IBCNS)) D
- . . . . S GIEN=$O(^IBA(355.3,"B",IBCNS,"")) ; Group Plan IEN, file 355.3
- . . . . ;
- . . . . ; Add Insurance Company/Group Plan to 'selected' list
- . . . . S ^TMP("IBINC",$J,IBIC1,IBCNS,GIEN)=""
- ;
- ; Display selected Insurance- user selected companies or plans
- S IBIC=""
- F S IBIC=$O(^TMP("IBINC",$J,IBIC)) Q:IBIC="" D
- . S IBCNS=0
- . F S IBCNS=$O(^TMP("IBINC",$J,IBIC,IBCNS)) Q:'IBCNS D GATH
- D PRINT
- Q
- ;
- PRINT ; Print report
- D ^IBCOPP3
- K ^TMP($J,"PR"),^TMP("IBINC",$J)
- ;
- I $D(ZTQUEUED) S ZTREQ="@" Q
- D ^%ZISC
- K IBAI,IBAIA,IBAO,IBAIPA,IBAPA,IBAPL,IBCNS,IBCPS,IBCPT,IBCST,IBI,IBIC,IBIC1
- Q
- ;
- GATH ; Gather all data for an Insurance Company.
- ; Input: IBI - Current Insurance Company Counter
- ; IBIC - Insurance Company Name
- ; IBSNS - IEN of the Insurance Company, file 36
- ; ^TMP("IBINC",$J,IBIC,IBCNS,IBPTR) - See EN for detail
- ; Output: IBI - Updated Insurance Company Counter
- ; ^TMP($J,"PR",IBI)=A1^A2^...^A11 Where:
- ; IBI - Counter of # of Insurance Companies included
- ; (starts at 1)
- ; A1 - Ins. Co. Name (1st 25 characters)
- ; Leading '*' if inactive
- ; A2 - Street Address Line 1
- ; A3 - City, State Zip Code (up to 9 digits + dash)
- ; A4 - Timely Filing Timeframe
- ; A5 - # of total plans for the Insurance Company
- ; A6 - # of total subscribers per Insurance Company
- ; A7 - # of selected Plans per Insurance Company
- ; A8 - # of subscribers per selected plans
- ; A9 - Max length of Electronic Plan Type for Ins Co
- ; A10 - Max length of Plan Type for Ins Co
- ; A11 - Max length of Patient ID for Ins Co
- ;
- N IBCPS,IBCPT,IBCSS,IBCST,LENEP,LENPID,LENPT,XX
- S IBI=IBI+1,(IBCPT,IBCPS,IBCST,IBCSS)=0 ; Initialize counters
- S (LENEP,LENPID,LENPT)=0 ; Init Max Elec Plan, Pat Id, Plan Type lengths
- D COMP(.LENPID) ; Gather company info
- D PLAN(.LENEP,.LENPT) ; Gather plan info
- ;
- ; Set final company info
- S XX=$$COMPINF(IBCNS)
- S XX=XX_"^"_IBCPT_"^"_IBCST_"^"_IBCPS_"^"_IBCSS_"^"_LENEP_"^"_LENPT_"^"_LENPID
- S ^TMP($J,"PR",IBI)=XX
- K ^TMP($J,"PL")
- Q
- ;
- COMP(LENPID) ; Gather Company counts and subscription information, if necessary
- ; Input: IBPA - 0 - List Insurance Plans by Insurance Company
- ; 1 - List Insurance Plans by Insurance Company
- ; with Subscriber information
- ; IBAPL - 0 - User selected Group Plans
- ; 1 - All Group Plans selected
- ; IBCNS - IEN of the insurance company, file #36
- ; ^TMP("IBINC",$J,IBIC,ICBNS)) - See EN for details
- ; Output: LENPID - Maximum length of Patient ID field for subscribers of
- ; this Insurance Company
- ; IBCSS - Total # of Subscribers in selected Group Plans
- ; IBCST - Total # of Subscribers
- ; ^TMP($J,"PR",IBI,IBPTR,IBNAM_"@@"_DFN_"@@"_IBCDFN)=B1^B2^...^B10 Where
- ; DFN - IEN of the patient, file 2
- ; IBCDFN- Insurance Company multiple
- ; IBI - Insurance counter
- ; IBNAM - Patient's Name (B1)
- ; IBPTR - IEN of the Group Plan, file 355.3
- ; B1 - Patient's Name (1st 22 chars)
- ; B2 - Last 4 Patient's SSN (with trailing 'P' if pseudo)
- ; B3 - Patient's DOB (mm/dd/yy)
- ; B4 - Subscriber ID (20 chars max)
- ; B5 - Effective Date (mm/dd/yy)
- ; B6 - Expiration Date (mm/dd/yy)
- ; B7 - Whose Insurance (5 chars max)
- ; B8 - Patient ID (30 chars max)
- ;
- N DFN,IBCDFN,IBIND,IBNAM,IBPTR,IBX,PTLEN,VA,VAERR,VAOA,X,XX,Y
- S DFN=0
- F S DFN=$O(^DPT("AB",IBCNS,DFN)) Q:'DFN D
- . S IBCDFN=0
- . ;
- . ; NOTE: IBCDFN is the Insurance Company Multiple that contains the
- . ; Insurance company with an IEN of IBCNS
- . F S IBCDFN=$O(^DPT("AB",IBCNS,DFN,IBCDFN)) Q:'IBCDFN D
- . . ;
- . . ; Set company subscriber count; plan subscriber counts if necessary
- . . ; MRD;IB*2.0*516 - Use $$ZND^IBCNS1 to pull .312 zero node.
- . . ;S IBIND=$G(^DPT(DFN,.312,+IBCDFN,0)) Q:+IBIND'=IBCNS
- . . S IBIND=$$ZND^IBCNS1(DFN,+IBCDFN)
- . . Q:+IBIND'=IBCNS
- . . S IBPTR=+$P(IBIND,"^",18) ; Group Plan IEN
- . . Q:'+IBPTR
- . . S IBCST=IBCST+1 ; Update Total # of Subscribers
- . . ;
- . . ; Quit if not a selected Group Plan and All Group Plans were not selected
- . . I 'IBAPL,'$D(^TMP("IBINC",$J,IBIC,IBCNS,IBPTR)) Q
- . . S IBCSS=IBCSS+1 ; Update Tot # of Selected Subscribers
- . . S ^TMP($J,"PL",IBPTR)=$G(^TMP($J,"PL",IBPTR))+1
- . . Q:'IBAPA ; Subscriber information not selected
- . . ;
- . . ; Gather Demographic/Policy information
- . . ; IB*2.0*549 - Changed fields retrieve for Subscriber Detail display
- . . S X=$$PT^IBEFUNC(DFN)
- . . S IBNAM=$E($P(X,"^",1),1,22) ; Patient's Name (22 chars)
- . . S:IBNAM="" IBNAM="<Pt. "_DFN_" Name Missing>"
- . . S IBX=IBNAM
- . . ;
- . . ; Retrieve last 4 of SSN (last 5 if pseudo SSN)
- . . S XX=$$GET1^DIQ(2,DFN_",",.09,"I") ; Patient's SSN
- . . S XX=$S($E(XX,$L(XX))="P":$E(XX,$L(XX)-4,$L(XX)),1:$E(XX,$L(XX)-3,$L(XX)))
- . . S $P(IBX,"^",2)=XX
- . . S XX=$$GET1^DIQ(2,DFN_",",.03,"I") ; Patient's DOB
- . . S $P(IBX,"^",3)=$$FMTE^XLFDT(XX,"2DZ")
- . . S XX=$P(IBIND,"^",2),XX=$S(XX'="":XX,1:"<NO SUBS ID>")
- . . S $P(IBX,"^",4)=XX ; Subscriber ID (20 chars max)
- . . S XX=$$FMTE^XLFDT($P(IBIND,"^",8),"2DZ") ; Effective Date
- . . S $P(IBX,"^",5)=XX
- . . S XX=$$FMTE^XLFDT($P(IBIND,"^",4),"2DZ") ; Expiration Date
- . . S $P(IBX,"^",6)=XX
- . . ;
- . . ; Whose Insurance?
- . . S XX=$P(IBIND,"^",6),XX=$S(XX="v":"VET",XX="s":"SPO",XX="o":"OTH",1:"UNK")
- . . S $P(IBX,"^",7)=XX
- . . S XX=$$GET1^DIQ(2.312,IBCDFN_","_DFN_",",5.01,"I") ; Patient ID
- . . S $P(IBX,"^",8)=XX
- . . S:LENPID<$L(XX) LENPID=$L(XX)
- . . S ^TMP($J,"PR",IBI,IBPTR,IBNAM_"@@"_DFN_"@@"_IBCDFN)=IBX
- Q
- ;
- PLAN(LENEP,LENPT) ; Gather Group Insurance Plan information
- ; Input: LENEP - Current Maximum Electronic Plan length for Ins Co
- ; LENPT - Current Maximum Plan Type length for Ins Co
- ; IBAPL - 0 - User selected Group Plans
- ; 1 - All Group Plans
- ; IBCNS - IEN of the Insurance Company, file #36
- ; IBPTR - IEN of the Group Insurance Plan, file 355.3
- ; ^TMP("IBINC",$J,IBIC,ICBNS,IBPTR)) - See EN for details
- ; ^TMP($J,"PL",IBPTR) - Total # Subscribers for Group Plan
- ; Output: LENEP - Updated Maximum Electronic Plan length for Ins Co
- ; LENPT - Updated Maximum Plan Type length for Ins Co
- ; IBCPS - Total Number of Selected Group Plans for Ins. Co.
- ; IBCPT - Total # of Group Plans for Insurance Company
- ; ^TMP($J,"PR",IBI,IBPTR)) - B1^B2^..^B6 where
- ; IBI - Counter of # of Insurance Companies included
- ; IBPTR- Group Plan IEN
- ; B1 - Group Number, field 355.3,2.02
- ; B2 - Group Name, field 355.3,2.01
- ; B3 - Group Plan Timely Filing Time frame (max len 21)
- ; B4 - Electronic Plan Type (max length 26)
- ; B5 - Type of Plan (max length 34)
- ; B6 - Total # of subscribers for this Group Plan
- ;
- N IBPTR
- S IBPTR=0
- F S IBPTR=$O(^IBA(355.3,"B",IBCNS,IBPTR)) Q:'IBPTR D
- . S IBCPT=IBCPT+1 ; Total # of Group Plans for Ins. Co.
- . ;
- . ; Quit if Group Plan was not selected by the user
- . I 'IBAPL,'$D(^TMP("IBINC",$J,IBIC,IBCNS,IBPTR)) Q
- . S IBCPS=IBCPS+1 ; Total # of Selected Group Plans
- . S ^TMP($J,"PR",IBI,IBPTR)=$$PLANINF(IBPTR,.LENEP,.LENPT)_"^"_+$G(^TMP($J,"PL",IBPTR))
- Q
- ;
- PLANINF(PLAN,LENEP,LENPT) ; Return formatted Group Insurance Plan information.
- ; Input: PLAN - IEN of the Group Insurance Plan, file #355.3
- ; LENEP - Current Maximum Electronic Plan length for Ins Co
- ; LENPT - Current Maximum Plan Type length for Ins Co
- ; Output: LENEP - Updated Maximum Electronic Plan length for Ins Co
- ; LENPT - Updated Maximum Plan Type length for Ins Co
- ; Returns: A1^A2^A3^...^AN Where:
- ; A1 - Group Plan Number
- ; A2 - Group Plan Name (leading '*' if Inactive)
- ; A3 - Group Plan Timely Filing Time frame (max len 21)
- ; A4 - Electronic Plan Type (max length 26)
- ; A5 - Type of Plan (max length 34)
- ;
- ; IB*2.0*549 Changed output to fields listed above
- N NAME,NUM,XX,ZZ
- S NUM=$$GET1^DIQ(355.3,PLAN,2.02)
- S:NUM="" NUM="<NO GROUP NUMBER>"
- S XX=$$GET1^DIQ(355.3,PLAN,.02,"I") ; Group or Individual Plan
- S XX=$S(XX=1:"",1:"+")
- S ZZ=$$GET1^DIQ(355.3,PLAN,.11,"I") ; Inactive Flag
- S ZZ=XX_$S(ZZ=1:"*",1:"")
- S $P(XX,"^",1)=ZZ_NUM ; Add Inactive/Individual flags
- S NAME=$$GET1^DIQ(355.3,PLAN,2.01)
- S:NAME="" NAME="<NO GROUP NAME>"
- S $P(XX,"^",2)=NAME ; Group Name
- S $P(XX,"^",3)=$$FTFGP^IBCNEUT7(PLAN) ; Timely Filing Time Frame
- S ZZ=$$GET1^DIQ(355.3,PLAN_",",.15) ; Electronic Plan Type
- S:$L(ZZ)>LENEP LENEP=$L(ZZ) ; Maximum Electronic Plan length
- S $P(XX,"^",4)=ZZ
- S ZZ=$$GET1^DIQ(355.3,PLAN_",",.09) ; Type of Plan
- S:$L(ZZ)>34 ZZ=$E(ZZ,1,34)
- S:$L(ZZ)>LENEP LENEP=$L(ZZ) ; Maximum Plan Type length
- S $P(XX,"^",5)=ZZ
- Q XX
- ;
- COMPINF(IBCNS) ; Return formatted Insurance Company information
- ; Input: IBCNS - IEN of the Insurance Company, file #36
- ; Output: A1^A2^A3^A4 Where:
- ; A1 - Insurance Company name (first 25 chars)
- ; with leading '*' if inactive
- ; A2 - Street Address Line 1
- ; A3 - City, ST ZIP
- ; A4 - Timely Filing
- ;
- ; IB*2.0*549 Changed output to fields listed above
- N ST,X,X0,X11,XX,Z,ZZ
- S X0=$G(^DIC(36,IBCNS,0))
- S X11=$G(^DIC(36,IBCNS,.11))
- S Z=$P(X11,"^",6)
- S ST=$S($P(X11,"^",5):$P($G(^DIC(5,$P(X11,"^",5),0)),"^",2),1:"<STATE MISSING>")
- S XX=$S($P(X0,"^",5):"*",1:"")
- S X=XX_$E($P(X0,"^",1),1,25)
- S $P(X,"^",2)=$S($P(X11,"^",1)'="":$P(X11,"^",1),1:"<Street Addr. 1 Missing>")
- S $P(X,"^",3)=$P(X11,"^",4)_", "_ST_" "_$E(Z,1,5)_$S($E(Z,6,9)]"":"-"_$E(Z,6,9),1:"")
- S $P(X,"^",4)=$$FTFIC^IBCNEUT7(IBCNS)
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOPP2 13416 printed Mar 13, 2025@21:23:31 Page 2
- IBCOPP2 ;ALB/NLR - LIST INS. PLANS BY CO. (COMPILE) ; 20-OCT-2015
- +1 ;;2.0;INTEGRATED BILLING;**28,62,93,516,528,549**;21-MAR-94;Build 54
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- EN ; Queued Entry Point for Report.
- +1 ; Input: IBAI - 0 - User selected Insurance Companies
- +2 ; 1 - Run report for all Insurance Companies with Plans
- +3 ; IBAIA - 0 - Only select Inactive Insurance Companies
- +4 ; 1 - Only select Active Insurance Companies
- +5 ; 2 - Select both Active and Inactive Insurance Companies
- +6 ; IBAIPA 0 - Only select Inactive Insurance Company Plans
- +7 ; 1 - Only select Active Insurance Company Plans
- +8 ; 2 - Select both Active and Inactive Insurance Company Plans
- +9 ; IBAO= E - Output to Excel
- +10 ; R - Report
- +11 ; IBAPA - 0 - List Insurance Plans by Insurance Company
- +12 ; 1 - List Insurance Plans by Insurance Company
- +13 ; with Subscriber information
- +14 ; IBAPA - 0 - List Insurance Plans by Insurance Company
- +15 ; 1 - List Insurance Plans by Insurance Company with Subscriber
- +16 ; information
- +17 ; IBAPL - 0 - User selected Group Plans
- +18 ; 1 - Run report for all Group Plans for each Ins. Co
- +19 ; NOTE: only used if IBAI=1, otherwise, some Insurance
- +20 ; companies may select all Group Plans and some
- +21 ; may be use selected Group Plans
- +22 ; ^TMP("IBINC",$J,IBIC,IBCNS,IBPTR)="" - Selected Ins Cos/Plans
- +23 ; Required if all Insurance Companies and all Group Plans
- +24 ; not selected Where:
- +25 ; IBIC - Insurance Company Name
- +26 ; IBCNS - IEN of the selected Insurance Company, file 36
- +27 ; IBPTR - IEN of the selected Group Plan, file 355.3
- +28 ;
- +29 ; Compile report data
- +30 NEW GIEN,XX
- +31 SET IBI=0
- +32 KILL ^TMP($JOB,"PR"),^TMP($JOB,"PL")
- +33 ;
- +34 ; Display all Insurance Companies and all Group Plans
- +35 IF IBAI
- IF IBAPL
- Begin DoDot:1
- +36 SET IBIC1=""
- +37 FOR
- SET IBIC1=$ORDER(^DIC(36,"B",IBIC1))
- if IBIC1=""
- QUIT
- Begin DoDot:2
- +38 SET IBCNS=0
- +39 FOR
- SET IBCNS=$ORDER(^DIC(36,"B",IBIC1,IBCNS))
- if 'IBCNS
- QUIT
- Begin DoDot:3
- +40 IF $DATA(^IBA(355.3,"B",IBCNS))
- Begin DoDot:4
- +41 ; Group Plan IEN, file 355.3
- SET GIEN=$ORDER(^IBA(355.3,"B",IBCNS,""))
- +42 ;
- +43 ; Add Insurance Company/Group Plan to 'selected' list
- +44 SET ^TMP("IBINC",$JOB,IBIC1,IBCNS,GIEN)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +45 ;
- +46 ; Display selected Insurance- user selected companies or plans
- +47 SET IBIC=""
- +48 FOR
- SET IBIC=$ORDER(^TMP("IBINC",$JOB,IBIC))
- if IBIC=""
- QUIT
- Begin DoDot:1
- +49 SET IBCNS=0
- +50 FOR
- SET IBCNS=$ORDER(^TMP("IBINC",$JOB,IBIC,IBCNS))
- if 'IBCNS
- QUIT
- DO GATH
- End DoDot:1
- +51 DO PRINT
- +52 QUIT
- +53 ;
- PRINT ; Print report
- +1 DO ^IBCOPP3
- +2 KILL ^TMP($JOB,"PR"),^TMP("IBINC",$JOB)
- +3 ;
- +4 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +5 DO ^%ZISC
- +6 KILL IBAI,IBAIA,IBAO,IBAIPA,IBAPA,IBAPL,IBCNS,IBCPS,IBCPT,IBCST,IBI,IBIC,IBIC1
- +7 QUIT
- +8 ;
- GATH ; Gather all data for an Insurance Company.
- +1 ; Input: IBI - Current Insurance Company Counter
- +2 ; IBIC - Insurance Company Name
- +3 ; IBSNS - IEN of the Insurance Company, file 36
- +4 ; ^TMP("IBINC",$J,IBIC,IBCNS,IBPTR) - See EN for detail
- +5 ; Output: IBI - Updated Insurance Company Counter
- +6 ; ^TMP($J,"PR",IBI)=A1^A2^...^A11 Where:
- +7 ; IBI - Counter of # of Insurance Companies included
- +8 ; (starts at 1)
- +9 ; A1 - Ins. Co. Name (1st 25 characters)
- +10 ; Leading '*' if inactive
- +11 ; A2 - Street Address Line 1
- +12 ; A3 - City, State Zip Code (up to 9 digits + dash)
- +13 ; A4 - Timely Filing Timeframe
- +14 ; A5 - # of total plans for the Insurance Company
- +15 ; A6 - # of total subscribers per Insurance Company
- +16 ; A7 - # of selected Plans per Insurance Company
- +17 ; A8 - # of subscribers per selected plans
- +18 ; A9 - Max length of Electronic Plan Type for Ins Co
- +19 ; A10 - Max length of Plan Type for Ins Co
- +20 ; A11 - Max length of Patient ID for Ins Co
- +21 ;
- +22 NEW IBCPS,IBCPT,IBCSS,IBCST,LENEP,LENPID,LENPT,XX
- +23 ; Initialize counters
- SET IBI=IBI+1
- SET (IBCPT,IBCPS,IBCST,IBCSS)=0
- +24 ; Init Max Elec Plan, Pat Id, Plan Type lengths
- SET (LENEP,LENPID,LENPT)=0
- +25 ; Gather company info
- DO COMP(.LENPID)
- +26 ; Gather plan info
- DO PLAN(.LENEP,.LENPT)
- +27 ;
- +28 ; Set final company info
- +29 SET XX=$$COMPINF(IBCNS)
- +30 SET XX=XX_"^"_IBCPT_"^"_IBCST_"^"_IBCPS_"^"_IBCSS_"^"_LENEP_"^"_LENPT_"^"_LENPID
- +31 SET ^TMP($JOB,"PR",IBI)=XX
- +32 KILL ^TMP($JOB,"PL")
- +33 QUIT
- +34 ;
- COMP(LENPID) ; Gather Company counts and subscription information, if necessary
- +1 ; Input: IBPA - 0 - List Insurance Plans by Insurance Company
- +2 ; 1 - List Insurance Plans by Insurance Company
- +3 ; with Subscriber information
- +4 ; IBAPL - 0 - User selected Group Plans
- +5 ; 1 - All Group Plans selected
- +6 ; IBCNS - IEN of the insurance company, file #36
- +7 ; ^TMP("IBINC",$J,IBIC,ICBNS)) - See EN for details
- +8 ; Output: LENPID - Maximum length of Patient ID field for subscribers of
- +9 ; this Insurance Company
- +10 ; IBCSS - Total # of Subscribers in selected Group Plans
- +11 ; IBCST - Total # of Subscribers
- +12 ; ^TMP($J,"PR",IBI,IBPTR,IBNAM_"@@"_DFN_"@@"_IBCDFN)=B1^B2^...^B10 Where
- +13 ; DFN - IEN of the patient, file 2
- +14 ; IBCDFN- Insurance Company multiple
- +15 ; IBI - Insurance counter
- +16 ; IBNAM - Patient's Name (B1)
- +17 ; IBPTR - IEN of the Group Plan, file 355.3
- +18 ; B1 - Patient's Name (1st 22 chars)
- +19 ; B2 - Last 4 Patient's SSN (with trailing 'P' if pseudo)
- +20 ; B3 - Patient's DOB (mm/dd/yy)
- +21 ; B4 - Subscriber ID (20 chars max)
- +22 ; B5 - Effective Date (mm/dd/yy)
- +23 ; B6 - Expiration Date (mm/dd/yy)
- +24 ; B7 - Whose Insurance (5 chars max)
- +25 ; B8 - Patient ID (30 chars max)
- +26 ;
- +27 NEW DFN,IBCDFN,IBIND,IBNAM,IBPTR,IBX,PTLEN,VA,VAERR,VAOA,X,XX,Y
- +28 SET DFN=0
- +29 FOR
- SET DFN=$ORDER(^DPT("AB",IBCNS,DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +30 SET IBCDFN=0
- +31 ;
- +32 ; NOTE: IBCDFN is the Insurance Company Multiple that contains the
- +33 ; Insurance company with an IEN of IBCNS
- +34 FOR
- SET IBCDFN=$ORDER(^DPT("AB",IBCNS,DFN,IBCDFN))
- if 'IBCDFN
- QUIT
- Begin DoDot:2
- +35 ;
- +36 ; Set company subscriber count; plan subscriber counts if necessary
- +37 ; MRD;IB*2.0*516 - Use $$ZND^IBCNS1 to pull .312 zero node.
- +38 ;S IBIND=$G(^DPT(DFN,.312,+IBCDFN,0)) Q:+IBIND'=IBCNS
- +39 SET IBIND=$$ZND^IBCNS1(DFN,+IBCDFN)
- +40 if +IBIND'=IBCNS
- QUIT
- +41 ; Group Plan IEN
- SET IBPTR=+$PIECE(IBIND,"^",18)
- +42 if '+IBPTR
- QUIT
- +43 ; Update Total # of Subscribers
- SET IBCST=IBCST+1
- +44 ;
- +45 ; Quit if not a selected Group Plan and All Group Plans were not selected
- +46 IF 'IBAPL
- IF '$DATA(^TMP("IBINC",$JOB,IBIC,IBCNS,IBPTR))
- QUIT
- +47 ; Update Tot # of Selected Subscribers
- SET IBCSS=IBCSS+1
- +48 SET ^TMP($JOB,"PL",IBPTR)=$GET(^TMP($JOB,"PL",IBPTR))+1
- +49 ; Subscriber information not selected
- if 'IBAPA
- QUIT
- +50 ;
- +51 ; Gather Demographic/Policy information
- +52 ; IB*2.0*549 - Changed fields retrieve for Subscriber Detail display
- +53 SET X=$$PT^IBEFUNC(DFN)
- +54 ; Patient's Name (22 chars)
- SET IBNAM=$EXTRACT($PIECE(X,"^",1),1,22)
- +55 if IBNAM=""
- SET IBNAM="<Pt. "_DFN_" Name Missing>"
- +56 SET IBX=IBNAM
- +57 ;
- +58 ; Retrieve last 4 of SSN (last 5 if pseudo SSN)
- +59 ; Patient's SSN
- SET XX=$$GET1^DIQ(2,DFN_",",.09,"I")
- +60 SET XX=$SELECT($EXTRACT(XX,$LENGTH(XX))="P":$EXTRACT(XX,$LENGTH(XX)-4,$LENGTH(XX)),1:$EXTRACT(XX,$LENGTH(XX)-3,$LENGTH(XX)))
- +61 SET $PIECE(IBX,"^",2)=XX
- +62 ; Patient's DOB
- SET XX=$$GET1^DIQ(2,DFN_",",.03,"I")
- +63 SET $PIECE(IBX,"^",3)=$$FMTE^XLFDT(XX,"2DZ")
- +64 SET XX=$PIECE(IBIND,"^",2)
- SET XX=$SELECT(XX'="":XX,1:"<NO SUBS ID>")
- +65 ; Subscriber ID (20 chars max)
- SET $PIECE(IBX,"^",4)=XX
- +66 ; Effective Date
- SET XX=$$FMTE^XLFDT($PIECE(IBIND,"^",8),"2DZ")
- +67 SET $PIECE(IBX,"^",5)=XX
- +68 ; Expiration Date
- SET XX=$$FMTE^XLFDT($PIECE(IBIND,"^",4),"2DZ")
- +69 SET $PIECE(IBX,"^",6)=XX
- +70 ;
- +71 ; Whose Insurance?
- +72 SET XX=$PIECE(IBIND,"^",6)
- SET XX=$SELECT(XX="v":"VET",XX="s":"SPO",XX="o":"OTH",1:"UNK")
- +73 SET $PIECE(IBX,"^",7)=XX
- +74 ; Patient ID
- SET XX=$$GET1^DIQ(2.312,IBCDFN_","_DFN_",",5.01,"I")
- +75 SET $PIECE(IBX,"^",8)=XX
- +76 if LENPID<$LENGTH(XX)
- SET LENPID=$LENGTH(XX)
- +77 SET ^TMP($JOB,"PR",IBI,IBPTR,IBNAM_"@@"_DFN_"@@"_IBCDFN)=IBX
- End DoDot:2
- End DoDot:1
- +78 QUIT
- +79 ;
- PLAN(LENEP,LENPT) ; Gather Group Insurance Plan information
- +1 ; Input: LENEP - Current Maximum Electronic Plan length for Ins Co
- +2 ; LENPT - Current Maximum Plan Type length for Ins Co
- +3 ; IBAPL - 0 - User selected Group Plans
- +4 ; 1 - All Group Plans
- +5 ; IBCNS - IEN of the Insurance Company, file #36
- +6 ; IBPTR - IEN of the Group Insurance Plan, file 355.3
- +7 ; ^TMP("IBINC",$J,IBIC,ICBNS,IBPTR)) - See EN for details
- +8 ; ^TMP($J,"PL",IBPTR) - Total # Subscribers for Group Plan
- +9 ; Output: LENEP - Updated Maximum Electronic Plan length for Ins Co
- +10 ; LENPT - Updated Maximum Plan Type length for Ins Co
- +11 ; IBCPS - Total Number of Selected Group Plans for Ins. Co.
- +12 ; IBCPT - Total # of Group Plans for Insurance Company
- +13 ; ^TMP($J,"PR",IBI,IBPTR)) - B1^B2^..^B6 where
- +14 ; IBI - Counter of # of Insurance Companies included
- +15 ; IBPTR- Group Plan IEN
- +16 ; B1 - Group Number, field 355.3,2.02
- +17 ; B2 - Group Name, field 355.3,2.01
- +18 ; B3 - Group Plan Timely Filing Time frame (max len 21)
- +19 ; B4 - Electronic Plan Type (max length 26)
- +20 ; B5 - Type of Plan (max length 34)
- +21 ; B6 - Total # of subscribers for this Group Plan
- +22 ;
- +23 NEW IBPTR
- +24 SET IBPTR=0
- +25 FOR
- SET IBPTR=$ORDER(^IBA(355.3,"B",IBCNS,IBPTR))
- if 'IBPTR
- QUIT
- Begin DoDot:1
- +26 ; Total # of Group Plans for Ins. Co.
- SET IBCPT=IBCPT+1
- +27 ;
- +28 ; Quit if Group Plan was not selected by the user
- +29 IF 'IBAPL
- IF '$DATA(^TMP("IBINC",$JOB,IBIC,IBCNS,IBPTR))
- QUIT
- +30 ; Total # of Selected Group Plans
- SET IBCPS=IBCPS+1
- +31 SET ^TMP($JOB,"PR",IBI,IBPTR)=$$PLANINF(IBPTR,.LENEP,.LENPT)_"^"_+$GET(^TMP($JOB,"PL",IBPTR))
- End DoDot:1
- +32 QUIT
- +33 ;
- PLANINF(PLAN,LENEP,LENPT) ; Return formatted Group Insurance Plan information.
- +1 ; Input: PLAN - IEN of the Group Insurance Plan, file #355.3
- +2 ; LENEP - Current Maximum Electronic Plan length for Ins Co
- +3 ; LENPT - Current Maximum Plan Type length for Ins Co
- +4 ; Output: LENEP - Updated Maximum Electronic Plan length for Ins Co
- +5 ; LENPT - Updated Maximum Plan Type length for Ins Co
- +6 ; Returns: A1^A2^A3^...^AN Where:
- +7 ; A1 - Group Plan Number
- +8 ; A2 - Group Plan Name (leading '*' if Inactive)
- +9 ; A3 - Group Plan Timely Filing Time frame (max len 21)
- +10 ; A4 - Electronic Plan Type (max length 26)
- +11 ; A5 - Type of Plan (max length 34)
- +12 ;
- +13 ; IB*2.0*549 Changed output to fields listed above
- +14 NEW NAME,NUM,XX,ZZ
- +15 SET NUM=$$GET1^DIQ(355.3,PLAN,2.02)
- +16 if NUM=""
- SET NUM="<NO GROUP NUMBER>"
- +17 ; Group or Individual Plan
- SET XX=$$GET1^DIQ(355.3,PLAN,.02,"I")
- +18 SET XX=$SELECT(XX=1:"",1:"+")
- +19 ; Inactive Flag
- SET ZZ=$$GET1^DIQ(355.3,PLAN,.11,"I")
- +20 SET ZZ=XX_$SELECT(ZZ=1:"*",1:"")
- +21 ; Add Inactive/Individual flags
- SET $PIECE(XX,"^",1)=ZZ_NUM
- +22 SET NAME=$$GET1^DIQ(355.3,PLAN,2.01)
- +23 if NAME=""
- SET NAME="<NO GROUP NAME>"
- +24 ; Group Name
- SET $PIECE(XX,"^",2)=NAME
- +25 ; Timely Filing Time Frame
- SET $PIECE(XX,"^",3)=$$FTFGP^IBCNEUT7(PLAN)
- +26 ; Electronic Plan Type
- SET ZZ=$$GET1^DIQ(355.3,PLAN_",",.15)
- +27 ; Maximum Electronic Plan length
- if $LENGTH(ZZ)>LENEP
- SET LENEP=$LENGTH(ZZ)
- +28 SET $PIECE(XX,"^",4)=ZZ
- +29 ; Type of Plan
- SET ZZ=$$GET1^DIQ(355.3,PLAN_",",.09)
- +30 if $LENGTH(ZZ)>34
- SET ZZ=$EXTRACT(ZZ,1,34)
- +31 ; Maximum Plan Type length
- if $LENGTH(ZZ)>LENEP
- SET LENEP=$LENGTH(ZZ)
- +32 SET $PIECE(XX,"^",5)=ZZ
- +33 QUIT XX
- +34 ;
- COMPINF(IBCNS) ; Return formatted Insurance Company information
- +1 ; Input: IBCNS - IEN of the Insurance Company, file #36
- +2 ; Output: A1^A2^A3^A4 Where:
- +3 ; A1 - Insurance Company name (first 25 chars)
- +4 ; with leading '*' if inactive
- +5 ; A2 - Street Address Line 1
- +6 ; A3 - City, ST ZIP
- +7 ; A4 - Timely Filing
- +8 ;
- +9 ; IB*2.0*549 Changed output to fields listed above
- +10 NEW ST,X,X0,X11,XX,Z,ZZ
- +11 SET X0=$GET(^DIC(36,IBCNS,0))
- +12 SET X11=$GET(^DIC(36,IBCNS,.11))
- +13 SET Z=$PIECE(X11,"^",6)
- +14 SET ST=$SELECT($PIECE(X11,"^",5):$PIECE($GET(^DIC(5,$PIECE(X11,"^",5),0)),"^",2),1:"<STATE MISSING>")
- +15 SET XX=$SELECT($PIECE(X0,"^",5):"*",1:"")
- +16 SET X=XX_$EXTRACT($PIECE(X0,"^",1),1,25)
- +17 SET $PIECE(X,"^",2)=$SELECT($PIECE(X11,"^",1)'="":$PIECE(X11,"^",1),1:"<Street Addr. 1 Missing>")
- +18 SET $PIECE(X,"^",3)=$PIECE(X11,"^",4)_", "_ST_" "_$EXTRACT(Z,1,5)_$SELECT($EXTRACT(Z,6,9)]"":"-"_$EXTRACT(Z,6,9),1:"")
- +19 SET $PIECE(X,"^",4)=$$FTFIC^IBCNEUT7(IBCNS)
- +20 QUIT X
