IBCOPP3 ;ALB/NLR - LIST INS. PLANS BY CO. (PRINT) ; 20-OCT-2015
;;2.0;INTEGRATED BILLING;**28,516,528,549**;21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
; Print the report.
; Input: IBAI - 0 - Only Selected Insurance Companies
; 1 - All Insurance Companies
; IBAIA - 0 - Only select Inactive Insurance Companies
; 1 - Only select Active Insurance Companies
; 2 - Select both Active and Inactive Insurance
; Companies
; 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
; IBAIPA - 0 - Only select Inactive Insurance Company Plans
; 1 - Only select Active Insurance Company Plans
; 2 - Select both Active and Inactive Insurance
; Company Plans
; IBAPL - 0 - Only list selected plans for Insurance Companies
; 1 - List all plans for selected Insurance Companies
; ^TMP($J,"PR" - Global Print Array
; ^TMP($J,"PR",IBI)=A1^A2^...^A10 Where:
; IBI - Counter of # of Insurance Companies included
; (starts at 1)
; A1 - Insurance Company Name (1st 25 characters)
; 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 - Maximum Length of the Electronic Plan
; Field for this Insurance Company
; A10 - Maximum Length of the Type of Plan
; Field for this Insurance Company
; A11 - Max length of Patient ID for Ins Co
; ^TMP($J,"PR",IBI,IBPTR))- B1^B2^..^B6 where
; IBI - Counter of # of Insurance Companies included
; IBPTR- Group Plan IEN, file 355.3
; 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 number of subscribers for Group Plan
; ^TMP($J,"PR",IBI,IBPTR,IBNAM_"@@"_DFN_"@@"_IBCDFN)=B1^B2^...^B8 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 COLEP,COLFTF,COLPID,TRUNCPT,XX,%
I IBAO="E" D Q
. D EXCEL
. W !!?30,"*** End of Report ***"
;
S (IBI,IBQUIT,IBPAG)=0
D NOW^%DTC
S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
;
F S IBI=$O(^TMP($J,"PR",IBI)) Q:'IBI S IBC=$G(^TMP($J,"PR",IBI)) D Q:IBQUIT
. D COMP(.COLEP,.COLFTF,.TRUNCPT)
. S IBP=0
. F S IBP=$O(^TMP($J,"PR",IBI,IBP)) Q:'IBP S IBPD=$G(^(IBP)) D Q:IBQUIT
. . I $Y>(IOSL-$S(IBAPA:9,1:5)) D PAUSE Q:IBQUIT D COMP(.COLEP,.COLFTF,.TRUNCPT)
. . D PLAN(COLEP,COLFTF,TRUNCPT)
. . ;
. . ; Display Subscriber Information
. . I IBAPA D
. . . S XX=$O(^TMP($J,"PR",IBI,IBP,"")) ; Are the subscribers to display
. . . D:XX'="" SUBHDR ; Display Subscriber Headers
. . . S IBS=""
. . . F S IBS=$O(^TMP($J,"PR",IBI,IBP,IBS)) Q:IBS="" D Q:IBQUIT
. . . . S IBSD=$G(^TMP($J,"PR",IBI,IBP,IBS))
. . . . D SUBS
. Q:IBQUIT
. ;
. ; Print company totals
. I $Y>(IOSL-4) D PAUSE Q:IBQUIT D
. . D COMP(.COLEP,.COLFTF,.TRUNCPT)
. . D PLAN(COLEP,COLFTF,TRUNCPT)
. W !!?90,"Number of Plans Selected = ",$P(IBC,"^",7)
. W !?76,"Total Subscribers Under Selected Plans = ",$P(IBC,"^",8)
. D PAUSE
;
; IB*2.0*549 - Added next line
W !!?30,"*** End of Report ***"
;
K IBAIA,IBAIPA,IBAPA,IBJJ,IBI,IBQUIT,IBPAG,IBHDT,IBC,IBP,IBPD,IBS,IBSD
Q
;
COMP(COLEP,COLFTF,TRUNCPT) ; Print Company header
; Input: IBC - ^TMP($J,"PR",IBC), see documentation above
; IBPAG - Current Page Counter
; IBHDT - Current date/time (external format)
; 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
; IBAPA - 0 - List Insurance Plans by Insurance Company
; 1 - List Insurance Plans by Insurance Company with
; Subscriber information
; Output: COLEP - Starting Column Position of the Electronic Plan Type Col
; COLFTF - Starting Column Position of the FTF Col
; TRUNCPT - # of characters to truncate from the Plan Type field (if any)
; IBPAG - Updated Page Counter
N LENEP,LENPT
K COLEP,COLFTF,TRUNCPT
S LENPT=$P(IBC,"^",9),LENEP=$P(IBC,"^",10)
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"LIST OF PLANS BY INSURANCE COMPANY"
W:IBAPA " WITH SUBSCRIBER INFORMATION"
W ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAG
W !,$TR($J(" ",IOM)," ","-")
;
; IB*2.0*549 - Added next 3 lines
W !,"+ =>INDIV. PLAN * => INACTIVE"
W !,"Filters: ",$S(IBAI=1:"All",1:"Selected")," Insurances"
W ", ",$S(IBAPL=1:"All",1:"Selected")," Group Plans",!
;
; IB*2.0*549 - Changed fields displayed for each Insurance Company
W !?1,$P(IBC,"^",1) ; Insurance Company Name (26 chars max)
W !?1,$P(IBC,"^",2) ; Street Address line 1 (35 chars max)
W ?45,"FTF = ",$P(IBC,"^",4) ; Timely Filing Timeframe (28 chars max)
W ?105,"GROUP PLAN TOTAL= ",$P(IBC,"^",5)
W !?1,$P(IBC,"^",3) ; City State Zip Code
W ?105,"SUBSCRIBER TOTAL= ",$P(IBC,"^",6)
;
; Check to see if the Plan Type and/or Electronic Plan Type fields need to be
; truncated
S COLEP=$S(LENPT<13:76,LENPT:64+LENPT+3,1:76) ; Elec Plan Col, assuming no truncation
S COLFTF=$S(LENEP<10:COLEP+13,1:COLEP+LENEP+3) ; FTF Col, assuming no truncation
S:'LENEP COLFTF=COLFTF+8
S TRUNCPT=0 ; Assume no truncation needed
I 64+$P(IBC,"^",9)+$P(IBC,"^",10)>103 D
. S TRUNCPT=(64+$P(IBC,"^",10))-103 ; # of Characters to truncate
. S COLEP=(64+$P(IBC,"^",10)+3)-TRUNCPT
. S COLFTF=COLEP+$P(IBC,"^",9)+2 ; FTF Col
W !?5,"GROUP NUMBER",?32,"GROUP NAME",?62,"TYPE OF PLAN"
W ?COLEP,"ELEC PLAN",?COLFTF,"FTF"
Q
;
PLAN(COLEP,COLFTF,TRUNCPT) ; Print Group Plan information.
; Input: COLEP - Starting Column Position of the Electronic Plan Type Col
; COLFTF - Starting Column Position of the FTF Col
; TRUNCPT - # of characters to truncate from the Plan Type field (if any)
; IBPD - ^TMP($J,"PR",IBC,IBPTR), see documentation above
; IBAPA - 0 - List Insurance Plans by Insurance Company
; 1 - List Insurance Plans by Insurance Company with
; Subscriber information
; ^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 40)
; B6 - Total # of subscribers for Group Plan
;
; IB*2.0*549 - Changed fields displayed for each Group Plan
N XX
W !?5,$P(IBPD,"^",1) ; Group Plan Number
W ?32,$P(IBPD,"^",2) ; Group Plan Name
S XX=$P(IBPD,"^",5)
S:TRUNCPT XX=$E(XX,1,$L(XX)-TRUNCPT)
W ?62,XX ; Type of Plan (40 Chars max)
W ?COLEP,$P(IBPD,"^",4) ; Electronic Plan Type (26 Chars max)
W ?COLFTF,$P(IBPD,"^",3) ; Group Plan FTF (26 Chars max)
W !?10,"SUBSCRIBERS = ",$P(IBPD,"^",6) ; Group Plan Subscriber total
Q
;
SUBHDR ; Print the Subscriber Header Line
; IB*2.0*549 New Method
W !?10,"SUBSCRIBER NAME",?35,"SSN",?43,"DOB",?53,"SUB ID",?76,"EFF",?86,"EXP"
W ?96,"WHO",?102,"PAT ID"
Q
;
SUBS ; Print subscriber information.
; IB*2.0*549 Changed fields displayed
; Input: IBSD - Subscriber detail - ^TMP($J,"PR",IBI,IBP,IBS)
; Subscriber ID to display more characters.
N COLEP,COLFTF,TRUNCPT
I $Y>(IOSL-4) D PAUSE Q:IBQUIT D
. D COMP(.COLEP,.COLFTF,.TRUNCPT)
. D PLAN(COLEP,COLFTF,TRUNCPT)
. D SUBHDR
W !?10,$P(IBSD,"^",1),?35,$P(IBSD,"^",2),?43,$P(IBSD,"^",3),?53,$P(IBSD,"^",4)
W ?76,$P(IBSD,"^",5),?86,$P(IBSD,"^",6),?96,$P(IBSD,"^",7),?102,$P(IBSD,"^",8)
Q
;
PAUSE ; Pause for screen output.
; Input: None
; Output: IBQUIT - 1 if user timed out or entered '^'
N DIR,DIRUT,DTOUT,DUOUT,IBJJ
Q:$E(IOST,1,2)'["C-"
S DIR(0)="E"
D ^DIR K DIR
I $D(DIRUT)!($D(DUOUT)) D
. S IBQUIT=1
Q
;
EXCEL ; Output in excel format
N HDR,IBC,IBHDT,IBP,IBPD,IBS,IBSD
D NOW^%DTC
S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
;
; Set Report Header into output
W !,"LIST OF PLANS BY INSURANCE COMPANY"
W:IBAPA " WITH SUBSCRIBER INFORMATION"
W " Run On: ",IBHDT
;
; Set filter into output
; IB*2.0*549 - Added next 3 lines
W !,"+ =>INDIV. PLAN * => INACTIVE"
W !,"Filters: ",$S(IBAI=1:"All",1:"Selected")," Insurances"
W ", ",$S(IBAPL=1:"All",1:"Selected")," Group Plans",!
;
S HDR="INS. CO.^ADDRESS^CITY,STATE ZIP^FTF^PLAN TOTAL^SUBS TOTAL^PLANS SELECTED^TOT SUBS"
S HDR=HDR_"^GROUP NUMBER^GROUP NAME^FTF^ELEC PLAN^TYPE OF PLAN^NO. SUBS"
I IBAPA S HDR=HDR_"^SUBSCRIBER NAME^SSN^DOB^SUB ID^EFF DT^EXP DT^WHOSE INS^PAT ID"
W !,HDR
S IBI=0
F S IBI=$O(^TMP($J,"PR",IBI)) Q:'IBI S IBC=$G(^TMP($J,"PR",IBI)) D
. S IBC=$P(IBC,"^",1,8),IBP=0
. F S IBP=$O(^TMP($J,"PR",IBI,IBP)) Q:'IBP S IBPD=$G(^TMP($J,"PR",IBI,IBP)) D
. . I 'IBAPA W !,IBC_U_IBPD Q
. . S IBS=""
. . F S IBS=$O(^TMP($J,"PR",IBI,IBP,IBS)) Q:IBS="" S IBSD=$G(^TMP($J,"PR",IBI,IBP,IBS)) D
. . . W !,IBC_U_IBPD_U_IBSD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOPP3 12043 printed Sep 23, 2025@19:54:49 Page 2
IBCOPP3 ;ALB/NLR - LIST INS. PLANS BY CO. (PRINT) ; 20-OCT-2015
+1 ;;2.0;INTEGRATED BILLING;**28,516,528,549**;21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Print the report.
+5 ; Input: IBAI - 0 - Only Selected Insurance Companies
+6 ; 1 - All Insurance Companies
+7 ; IBAIA - 0 - Only select Inactive Insurance Companies
+8 ; 1 - Only select Active Insurance Companies
+9 ; 2 - Select both Active and Inactive Insurance
+10 ; Companies
+11 ; IBAO - E - Output to Excel
+12 ; R - Report
+13 ; IBAPA - 0 - List Insurance Plans by Insurance Company
+14 ; 1 - List Insurance Plans by Insurance Company
+15 ; with Subscriber information
+16 ; IBAIPA - 0 - Only select Inactive Insurance Company Plans
+17 ; 1 - Only select Active Insurance Company Plans
+18 ; 2 - Select both Active and Inactive Insurance
+19 ; Company Plans
+20 ; IBAPL - 0 - Only list selected plans for Insurance Companies
+21 ; 1 - List all plans for selected Insurance Companies
+22 ; ^TMP($J,"PR" - Global Print Array
+23 ; ^TMP($J,"PR",IBI)=A1^A2^...^A10 Where:
+24 ; IBI - Counter of # of Insurance Companies included
+25 ; (starts at 1)
+26 ; A1 - Insurance Company Name (1st 25 characters)
+27 ; A2 - Street Address Line 1
+28 ; A3 - City, State Zip Code (up to 9 digits + dash)
+29 ; A4 - Timely Filing Timeframe
+30 ; A5 - # of total plans for the Insurance Company
+31 ; A6 - # of total subscribers per Insurance Company
+32 ; A7 - # of selected Plans per Insurance Company
+33 ; A8 - # of subscribers per selected plans
+34 ; A9 - Maximum Length of the Electronic Plan
+35 ; Field for this Insurance Company
+36 ; A10 - Maximum Length of the Type of Plan
+37 ; Field for this Insurance Company
+38 ; A11 - Max length of Patient ID for Ins Co
+39 ; ^TMP($J,"PR",IBI,IBPTR))- B1^B2^..^B6 where
+40 ; IBI - Counter of # of Insurance Companies included
+41 ; IBPTR- Group Plan IEN, file 355.3
+42 ; B1 - Group Number, field 355.3,2.02
+43 ; B2 - Group Name, field 355.3,2.01
+44 ; B3 - Group Plan Timely Filing Time frame (max len 21)
+45 ; B4 - Electronic Plan Type (max length 26)
+46 ; B5 - Type of Plan (max length 34)
+47 ; B6 - Total number of subscribers for Group Plan
+48 ; ^TMP($J,"PR",IBI,IBPTR,IBNAM_"@@"_DFN_"@@"_IBCDFN)=B1^B2^...^B8 Where
+49 ; DFN - IEN of the patient, file 2
+50 ; IBCDFN- Insurance Company multiple
+51 ; IBI - Insurance counter
+52 ; IBNAM - Patient's Name (B1)
+53 ; IBPTR - IEN of the Group Plan, file 355.3
+54 ; B1 - Patient's Name (1st 22 chars)
+55 ; B2 - Last 4 Patient's SSN (with trailing 'P' if pseudo)
+56 ; B3 - Patient's DOB (mm/dd/yy)
+57 ; B4 - Subscriber ID (20 chars max)
+58 ; B5 - Effective Date (mm/dd/yy)
+59 ; B6 - Expiration Date (mm/dd/yy)
+60 ; B7 - Whose Insurance (5 chars max)
+61 ; B8 - Patient ID (30 chars max)
+62 ;
+63 NEW COLEP,COLFTF,COLPID,TRUNCPT,XX,%
+64 IF IBAO="E"
Begin DoDot:1
+65 DO EXCEL
+66 WRITE !!?30,"*** End of Report ***"
End DoDot:1
QUIT
+67 ;
+68 SET (IBI,IBQUIT,IBPAG)=0
+69 DO NOW^%DTC
+70 SET IBHDT=$$DAT2^IBOUTL($EXTRACT(%,1,12))
+71 ;
+72 FOR
SET IBI=$ORDER(^TMP($JOB,"PR",IBI))
if 'IBI
QUIT
SET IBC=$GET(^TMP($JOB,"PR",IBI))
Begin DoDot:1
+73 DO COMP(.COLEP,.COLFTF,.TRUNCPT)
+74 SET IBP=0
+75 FOR
SET IBP=$ORDER(^TMP($JOB,"PR",IBI,IBP))
if 'IBP
QUIT
SET IBPD=$GET(^(IBP))
Begin DoDot:2
+76 IF $Y>(IOSL-$SELECT(IBAPA:9,1:5))
DO PAUSE
if IBQUIT
QUIT
DO COMP(.COLEP,.COLFTF,.TRUNCPT)
+77 DO PLAN(COLEP,COLFTF,TRUNCPT)
+78 ;
+79 ; Display Subscriber Information
+80 IF IBAPA
Begin DoDot:3
+81 ; Are the subscribers to display
SET XX=$ORDER(^TMP($JOB,"PR",IBI,IBP,""))
+82 ; Display Subscriber Headers
if XX'=""
DO SUBHDR
+83 SET IBS=""
+84 FOR
SET IBS=$ORDER(^TMP($JOB,"PR",IBI,IBP,IBS))
if IBS=""
QUIT
Begin DoDot:4
+85 SET IBSD=$GET(^TMP($JOB,"PR",IBI,IBP,IBS))
+86 DO SUBS
End DoDot:4
if IBQUIT
QUIT
End DoDot:3
End DoDot:2
if IBQUIT
QUIT
+87 if IBQUIT
QUIT
+88 ;
+89 ; Print company totals
+90 IF $Y>(IOSL-4)
DO PAUSE
if IBQUIT
QUIT
Begin DoDot:2
+91 DO COMP(.COLEP,.COLFTF,.TRUNCPT)
+92 DO PLAN(COLEP,COLFTF,TRUNCPT)
End DoDot:2
+93 WRITE !!?90,"Number of Plans Selected = ",$PIECE(IBC,"^",7)
+94 WRITE !?76,"Total Subscribers Under Selected Plans = ",$PIECE(IBC,"^",8)
+95 DO PAUSE
End DoDot:1
if IBQUIT
QUIT
+96 ;
+97 ; IB*2.0*549 - Added next line
+98 WRITE !!?30,"*** End of Report ***"
+99 ;
+100 KILL IBAIA,IBAIPA,IBAPA,IBJJ,IBI,IBQUIT,IBPAG,IBHDT,IBC,IBP,IBPD,IBS,IBSD
+101 QUIT
+102 ;
COMP(COLEP,COLFTF,TRUNCPT) ; Print Company header
+1 ; Input: IBC - ^TMP($J,"PR",IBC), see documentation above
+2 ; IBPAG - Current Page Counter
+3 ; IBHDT - Current date/time (external format)
+4 ; IBAIA - 0 - Only select Inactive Insurance Companies
+5 ; 1 - Only select Active Insurance Companies
+6 ; 2 - Select both Active and Inactive Insurance Companies
+7 ; IBAIPA - 0 - Only select Inactive Insurance Company Plans
+8 ; 1 - Only select Active Insurance Company Plans
+9 ; 2 - Select both Active and Inactive Insurance Company Plans
+10 ; IBAPA - 0 - List Insurance Plans by Insurance Company
+11 ; 1 - List Insurance Plans by Insurance Company with
+12 ; Subscriber information
+13 ; Output: COLEP - Starting Column Position of the Electronic Plan Type Col
+14 ; COLFTF - Starting Column Position of the FTF Col
+15 ; TRUNCPT - # of characters to truncate from the Plan Type field (if any)
+16 ; IBPAG - Updated Page Counter
+17 NEW LENEP,LENPT
+18 KILL COLEP,COLFTF,TRUNCPT
+19 SET LENPT=$PIECE(IBC,"^",9)
SET LENEP=$PIECE(IBC,"^",10)
+20 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+21 SET IBPAG=IBPAG+1
+22 WRITE !,"LIST OF PLANS BY INSURANCE COMPANY"
+23 if IBAPA
WRITE " WITH SUBSCRIBER INFORMATION"
+24 WRITE ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAG
+25 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+26 ;
+27 ; IB*2.0*549 - Added next 3 lines
+28 WRITE !,"+ =>INDIV. PLAN * => INACTIVE"
+29 WRITE !,"Filters: ",$SELECT(IBAI=1:"All",1:"Selected")," Insurances"
+30 WRITE ", ",$SELECT(IBAPL=1:"All",1:"Selected")," Group Plans",!
+31 ;
+32 ; IB*2.0*549 - Changed fields displayed for each Insurance Company
+33 ; Insurance Company Name (26 chars max)
WRITE !?1,$PIECE(IBC,"^",1)
+34 ; Street Address line 1 (35 chars max)
WRITE !?1,$PIECE(IBC,"^",2)
+35 ; Timely Filing Timeframe (28 chars max)
WRITE ?45,"FTF = ",$PIECE(IBC,"^",4)
+36 WRITE ?105,"GROUP PLAN TOTAL= ",$PIECE(IBC,"^",5)
+37 ; City State Zip Code
WRITE !?1,$PIECE(IBC,"^",3)
+38 WRITE ?105,"SUBSCRIBER TOTAL= ",$PIECE(IBC,"^",6)
+39 ;
+40 ; Check to see if the Plan Type and/or Electronic Plan Type fields need to be
+41 ; truncated
+42 ; Elec Plan Col, assuming no truncation
SET COLEP=$SELECT(LENPT<13:76,LENPT:64+LENPT+3,1:76)
+43 ; FTF Col, assuming no truncation
SET COLFTF=$SELECT(LENEP<10:COLEP+13,1:COLEP+LENEP+3)
+44 if 'LENEP
SET COLFTF=COLFTF+8
+45 ; Assume no truncation needed
SET TRUNCPT=0
+46 IF 64+$PIECE(IBC,"^",9)+$PIECE(IBC,"^",10)>103
Begin DoDot:1
+47 ; # of Characters to truncate
SET TRUNCPT=(64+$PIECE(IBC,"^",10))-103
+48 SET COLEP=(64+$PIECE(IBC,"^",10)+3)-TRUNCPT
+49 ; FTF Col
SET COLFTF=COLEP+$PIECE(IBC,"^",9)+2
End DoDot:1
+50 WRITE !?5,"GROUP NUMBER",?32,"GROUP NAME",?62,"TYPE OF PLAN"
+51 WRITE ?COLEP,"ELEC PLAN",?COLFTF,"FTF"
+52 QUIT
+53 ;
PLAN(COLEP,COLFTF,TRUNCPT) ; Print Group Plan information.
+1 ; Input: COLEP - Starting Column Position of the Electronic Plan Type Col
+2 ; COLFTF - Starting Column Position of the FTF Col
+3 ; TRUNCPT - # of characters to truncate from the Plan Type field (if any)
+4 ; IBPD - ^TMP($J,"PR",IBC,IBPTR), see documentation above
+5 ; IBAPA - 0 - List Insurance Plans by Insurance Company
+6 ; 1 - List Insurance Plans by Insurance Company with
+7 ; Subscriber information
+8 ; ^TMP($J,"PR",IBI,IBPTR))- B1^B2^..^B6 where
+9 ; IBI - Counter of # of Insurance Companies included
+10 ; IBPTR- Group Plan IEN
+11 ; B1 - Group Number, field 355.3,2.02
+12 ; B2 - Group Name, field 355.3,2.01
+13 ; B3 - Group Plan Timely Filing Time frame (max len 21)
+14 ; B4 - Electronic Plan Type (max length 26)
+15 ; B5 - Type of Plan (max length 40)
+16 ; B6 - Total # of subscribers for Group Plan
+17 ;
+18 ; IB*2.0*549 - Changed fields displayed for each Group Plan
+19 NEW XX
+20 ; Group Plan Number
WRITE !?5,$PIECE(IBPD,"^",1)
+21 ; Group Plan Name
WRITE ?32,$PIECE(IBPD,"^",2)
+22 SET XX=$PIECE(IBPD,"^",5)
+23 if TRUNCPT
SET XX=$EXTRACT(XX,1,$LENGTH(XX)-TRUNCPT)
+24 ; Type of Plan (40 Chars max)
WRITE ?62,XX
+25 ; Electronic Plan Type (26 Chars max)
WRITE ?COLEP,$PIECE(IBPD,"^",4)
+26 ; Group Plan FTF (26 Chars max)
WRITE ?COLFTF,$PIECE(IBPD,"^",3)
+27 ; Group Plan Subscriber total
WRITE !?10,"SUBSCRIBERS = ",$PIECE(IBPD,"^",6)
+28 QUIT
+29 ;
SUBHDR ; Print the Subscriber Header Line
+1 ; IB*2.0*549 New Method
+2 WRITE !?10,"SUBSCRIBER NAME",?35,"SSN",?43,"DOB",?53,"SUB ID",?76,"EFF",?86,"EXP"
+3 WRITE ?96,"WHO",?102,"PAT ID"
+4 QUIT
+5 ;
SUBS ; Print subscriber information.
+1 ; IB*2.0*549 Changed fields displayed
+2 ; Input: IBSD - Subscriber detail - ^TMP($J,"PR",IBI,IBP,IBS)
+3 ; Subscriber ID to display more characters.
+4 NEW COLEP,COLFTF,TRUNCPT
+5 IF $Y>(IOSL-4)
DO PAUSE
if IBQUIT
QUIT
Begin DoDot:1
+6 DO COMP(.COLEP,.COLFTF,.TRUNCPT)
+7 DO PLAN(COLEP,COLFTF,TRUNCPT)
+8 DO SUBHDR
End DoDot:1
+9 WRITE !?10,$PIECE(IBSD,"^",1),?35,$PIECE(IBSD,"^",2),?43,$PIECE(IBSD,"^",3),?53,$PIECE(IBSD,"^",4)
+10 WRITE ?76,$PIECE(IBSD,"^",5),?86,$PIECE(IBSD,"^",6),?96,$PIECE(IBSD,"^",7),?102,$PIECE(IBSD,"^",8)
+11 QUIT
+12 ;
PAUSE ; Pause for screen output.
+1 ; Input: None
+2 ; Output: IBQUIT - 1 if user timed out or entered '^'
+3 NEW DIR,DIRUT,DTOUT,DUOUT,IBJJ
+4 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+5 SET DIR(0)="E"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)!($DATA(DUOUT))
Begin DoDot:1
+8 SET IBQUIT=1
End DoDot:1
+9 QUIT
+10 ;
EXCEL ; Output in excel format
+1 NEW HDR,IBC,IBHDT,IBP,IBPD,IBS,IBSD
+2 DO NOW^%DTC
+3 SET IBHDT=$$DAT2^IBOUTL($EXTRACT(%,1,12))
+4 ;
+5 ; Set Report Header into output
+6 WRITE !,"LIST OF PLANS BY INSURANCE COMPANY"
+7 if IBAPA
WRITE " WITH SUBSCRIBER INFORMATION"
+8 WRITE " Run On: ",IBHDT
+9 ;
+10 ; Set filter into output
+11 ; IB*2.0*549 - Added next 3 lines
+12 WRITE !,"+ =>INDIV. PLAN * => INACTIVE"
+13 WRITE !,"Filters: ",$SELECT(IBAI=1:"All",1:"Selected")," Insurances"
+14 WRITE ", ",$SELECT(IBAPL=1:"All",1:"Selected")," Group Plans",!
+15 ;
+16 SET HDR="INS. CO.^ADDRESS^CITY,STATE ZIP^FTF^PLAN TOTAL^SUBS TOTAL^PLANS SELECTED^TOT SUBS"
+17 SET HDR=HDR_"^GROUP NUMBER^GROUP NAME^FTF^ELEC PLAN^TYPE OF PLAN^NO. SUBS"
+18 IF IBAPA
SET HDR=HDR_"^SUBSCRIBER NAME^SSN^DOB^SUB ID^EFF DT^EXP DT^WHOSE INS^PAT ID"
+19 WRITE !,HDR
+20 SET IBI=0
+21 FOR
SET IBI=$ORDER(^TMP($JOB,"PR",IBI))
if 'IBI
QUIT
SET IBC=$GET(^TMP($JOB,"PR",IBI))
Begin DoDot:1
+22 SET IBC=$PIECE(IBC,"^",1,8)
SET IBP=0
+23 FOR
SET IBP=$ORDER(^TMP($JOB,"PR",IBI,IBP))
if 'IBP
QUIT
SET IBPD=$GET(^TMP($JOB,"PR",IBI,IBP))
Begin DoDot:2
+24 IF 'IBAPA
WRITE !,IBC_U_IBPD
QUIT
+25 SET IBS=""
+26 FOR
SET IBS=$ORDER(^TMP($JOB,"PR",IBI,IBP,IBS))
if IBS=""
QUIT
SET IBSD=$GET(^TMP($JOB,"PR",IBI,IBP,IBS))
Begin DoDot:3
+27 WRITE !,IBC_U_IBPD_U_IBSD
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
