IBCOPP ;ALB/NLR - LIST INS. PLANS BY CO. (DRIVER) ; 20-OCT-2015
;;2.0;INTEGRATED BILLING;**28,62,528,549**;21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; Describe report
; IB*2.0*549 - reworded report description
W !!?5,"This report will generate a list of insurance plans by company."
W !?5,"It will help you identify duplicates. You must select one, many"
W !?5,"or all of the insurance companies; anywhere from one to all of the"
W !?5,"plans under each company; and whether to include the patient policies"
W !?5,"(subscribers) under each plan. The number of plans you select is "
W !?5,"independent for each company you are including, but the subscriber"
W !?5,"is the same (all or none) for all companies and plans within this report."
W !?5,"Regardless of how you run the report, the number of group plans per"
W !?5,"insurance company and the number of subscribers per plan will be"
W !?5,"included.",!!
;
; Prompt user to select report type, insurance companies, plans
;
; Output from user selections:
;
; 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
; 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
; IBAPL= 0 - Whether some or all ins. co's., user selects plans (may be
; all for certain companies, some for other companies)
; 1 - Whether some or all ins. co's., run report for all plans
; associated with those co's.
;
N A,I,IBAO,POP,ZTDESC,ZTDEXC,ZTRTN,ZTSAVE,%ZIS
K ^TMP("IBINC",$J)
S IBAPA=$$SELR^IBCOPP1 ; Report Type prompt
I IBAPA<0 D ENQ Q
S IBAI=$$SELI^IBCOPP1 ; All/Selected Ins. Cos. prompt
I IBAI<0 D ENQ Q
;
; IB*2.0*549 - Inactive/Active/Both Insurance Company look-up filter
; Only ask if user didn't select all Insurance Companies
S IBAIA=$$SELA^IBCOPP1
I IBAIA<0 D ENQ Q
;
; IB*2.0*549 - Added call to Insurance Company look-up listman template
; for selecting, moved from START method
; Allow user selection of Insurance Companies, if required
I 'IBAI D I IBQUIT=1 D ENQ Q
. N IBCNS,XX
. S IBQUIT=0
. D EN^IBCNILK(IBAIA)
. I '$D(^TMP("IBCNILKA",$J)) S IBQUIT=1 Q ; No Insurance Companies selected
. S IBCNS=""
. F S IBCNS=$O(^TMP("IBCNILKA",$J,IBCNS)) Q:IBCNS="" D
. . ;
. . ; Insurance Company Name
. . S XX=$E($$GET1^DIQ(36,IBCNS_",",.01),1,25)
. . S ^TMP("IBINC",$J,XX,IBCNS)=""
. K ^TMP("IBCNILKA",$J)
;
S IBAPL=$$SELP^IBCOPP1 ; Plan Selection prompt
I IBAPL<0 D ENQ Q
;
; IB*2.0*549 - Inactive/Active/Both Insurance Company Plan look-up filter
; Only ask if user didn't select all Group Plan
S IBAIPA=2
S:'IBAPL IBAIPA=$$SELPA^IBCOPP1
I IBAIPA<0 D ENQ Q
;
; All Insurance Companies, All Plans, skip to device prompt
I IBAI,IBAPL D Q
. S IBAO=$$OUT^IBCOPP1 ; Report or CSV output
. I IBAO<0 D ENQ Q
. D DEVICE
;
; Obtain Plans for selected or All Insurance Companies
D START
I IBQUIT D ENQ Q
I '$D(^TMP("IBINC",$J)) D Q
. W !!,*7,"No plans selected!"
. D ENQ
;
S IBAO=$$OUT^IBCOPP1 ; Report or CSV output
D DEVICE
Q
;
DEVICE ; Ask user to select device
;
N I,POP
I IBAO'="E" D
. W !!,"*** You will need a 132 column printer for this report. ***",!
E D
. W !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
. W !,"of the data saved to the file, please enter ""0;256;99999"" at the ""DEVICE:"""
. W !,"prompt.",!
S %ZIS="QM"
D ^%ZIS
I POP D ENQ Q
I $D(IO("Q")) D Q
. S ZTRTN="^IBCOPP2",ZTDESC="IB - LIST OF PLANS BY INSURANCE COMPANY"
. F I="^TMP(""IBINC"",$J,","IBAPA","IBAI","IBAPL","IBAO" S ZTSAVE(I)=""
. D ^%ZTLOAD
. K IO("Q")
. D HOME^%ZIS
. W !!,$S($D(ZTSK):"This job has been queued as task #"_ZTSK_".",1:"Unable to queue this job.")
. K ZTSK,IO("Q")
. D ENQ
;
; Compile and print report
U IO
D ^IBCOPP2
;
ENQ ;
K A,DIRUT,DIROUT,DUOUT,DTOUT,IBAO,IBAI,IBAIA,IBAIPA,IBAPA,IBAPL,IBQUIT,X,Y
K ^TMP("IBCNILKA",$J),^TMP("IBINC",$J)
Q
;
START ; Gather plans for all selected companies.
; 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
; IBAPL - 0 - Whether some or all ins. co's., user selects plans (may be
; all for certain companies, some for other companies)
; 1 - Whether some or all ins. co's., run report for all plans
; associated with those co's.
S (IBCT,IBQUIT)=0
I IBAPL D STARTQ Q
;
; Gather all Insurance Companies if required
I IBAI D
. N INACT
. S A=0
. F S A=$O(^IBA(355.3,"B",A)) Q:'A D
. . Q:$G(^DIC(36,A,0))=""
. . S INACT=+$$GET1^DIQ(36,A_",",.05,"I") ; Is the Insurance Company Inactive?
. . I INACT,IBAIA=1 Q ; IB*2.0*549 Only include Active Ins. Cos.
. . I 'INACT,IBAIA=0 Q ; IB*2.0*549 Only include Inactive Ins. Cos.
. . S ^TMP("IBINC",$J,$E($P($G(^DIC(36,A,0)),"^"),1,25),A)=""
;
; Gather plans for selected Insurance Companies
S IBIC=""
F S IBIC=$O(^TMP("IBINC",$J,IBIC)) Q:IBIC=""!IBQUIT D
. S IBCNS=""
. F S IBCNS=$O(^TMP("IBINC",$J,IBIC,IBCNS)) Q:IBCNS=""!(IBQUIT) D
. . S IBCT=IBCT+1
. . W !!,"Insurance Company # "_IBCT_": "_IBIC
. . D OK^IBCNSM3
. . Q:IBQUIT
. . I 'IBOK K ^TMP("IBINC",$J,IBIC,IBCNS) S IBAI=0 Q
. . W " ...building a list of plans..."
. . K IBSEL,^TMP($J,"IBSEL")
. . ;
. . ; IB*2.0*549 - Add Active/Inactive/Both Plan filter
. . S XX=$S(IBAIPA=0:2,IBAIPA=1:0,IBAIPA=2:1)
. . D LKP^IBCNSU2(IBCNS,1,1,.IBSEL,0,XX)
. . Q:IBQUIT
. . I '$O(^TMP($J,"IBSEL",0)) D Q
. . . K ^TMP("IBINC",$J,IBIC,IBCNS)
. . . S IBAI=0
. . ;
. . ; Set plans into an array
. . S IBPN=0
. . F S IBPN=$O(^TMP($J,"IBSEL",IBPN)) Q:'IBPN D
. . . S ^TMP("IBINC",$J,IBIC,IBCNS,IBPN)=""
;
STARTQ ;
K IBAO,IBCT,IBIC,IBJJ,IBLCT,IBCNS,IBOK,IBPN,IBSEL,^TMP($J,"IBSEL")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOPP 7100 printed Dec 13, 2024@02:18:31 Page 2
IBCOPP ;ALB/NLR - LIST INS. PLANS BY CO. (DRIVER) ; 20-OCT-2015
+1 ;;2.0;INTEGRATED BILLING;**28,62,528,549**;21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Describe report
+1 ; IB*2.0*549 - reworded report description
+2 WRITE !!?5,"This report will generate a list of insurance plans by company."
+3 WRITE !?5,"It will help you identify duplicates. You must select one, many"
+4 WRITE !?5,"or all of the insurance companies; anywhere from one to all of the"
+5 WRITE !?5,"plans under each company; and whether to include the patient policies"
+6 WRITE !?5,"(subscribers) under each plan. The number of plans you select is "
+7 WRITE !?5,"independent for each company you are including, but the subscriber"
+8 WRITE !?5,"is the same (all or none) for all companies and plans within this report."
+9 WRITE !?5,"Regardless of how you run the report, the number of group plans per"
+10 WRITE !?5,"insurance company and the number of subscribers per plan will be"
+11 WRITE !?5,"included.",!!
+12 ;
+13 ; Prompt user to select report type, insurance companies, plans
+14 ;
+15 ; Output from user selections:
+16 ;
+17 ; IBAO= E - Output to Excel
+18 ; R - Report
+19 ; IBAPA= 0 - List Insurance Plans by Insurance Company
+20 ; 1 - List Insurance Plans by Insurance Company with Subscriber
+21 ; information
+22 ; IBAI= 0 - User selected Insurance Companies
+23 ; 1 - Run report for all Insurance Companies with Plans
+24 ; IBAIA= 0 - Only select Inactive Insurance Companies
+25 ; 1 - Only select Active Insurance Companies
+26 ; 2 - Select both Active and Inactive Insurance Companies
+27 ; IBAIPA= 0 - Only select Inactive Insurance Company Plans
+28 ; 1 - Only select Active Insurance Company Plans
+29 ; 2 - Select both Active and Inactive Insurance Company Plans
+30 ; IBAPL= 0 - Whether some or all ins. co's., user selects plans (may be
+31 ; all for certain companies, some for other companies)
+32 ; 1 - Whether some or all ins. co's., run report for all plans
+33 ; associated with those co's.
+34 ;
+35 NEW A,I,IBAO,POP,ZTDESC,ZTDEXC,ZTRTN,ZTSAVE,%ZIS
+36 KILL ^TMP("IBINC",$JOB)
+37 ; Report Type prompt
SET IBAPA=$$SELR^IBCOPP1
+38 IF IBAPA<0
DO ENQ
QUIT
+39 ; All/Selected Ins. Cos. prompt
SET IBAI=$$SELI^IBCOPP1
+40 IF IBAI<0
DO ENQ
QUIT
+41 ;
+42 ; IB*2.0*549 - Inactive/Active/Both Insurance Company look-up filter
+43 ; Only ask if user didn't select all Insurance Companies
+44 SET IBAIA=$$SELA^IBCOPP1
+45 IF IBAIA<0
DO ENQ
QUIT
+46 ;
+47 ; IB*2.0*549 - Added call to Insurance Company look-up listman template
+48 ; for selecting, moved from START method
+49 ; Allow user selection of Insurance Companies, if required
+50 IF 'IBAI
Begin DoDot:1
+51 NEW IBCNS,XX
+52 SET IBQUIT=0
+53 DO EN^IBCNILK(IBAIA)
+54 ; No Insurance Companies selected
IF '$DATA(^TMP("IBCNILKA",$JOB))
SET IBQUIT=1
QUIT
+55 SET IBCNS=""
+56 FOR
SET IBCNS=$ORDER(^TMP("IBCNILKA",$JOB,IBCNS))
if IBCNS=""
QUIT
Begin DoDot:2
+57 ;
+58 ; Insurance Company Name
+59 SET XX=$EXTRACT($$GET1^DIQ(36,IBCNS_",",.01),1,25)
+60 SET ^TMP("IBINC",$JOB,XX,IBCNS)=""
End DoDot:2
+61 KILL ^TMP("IBCNILKA",$JOB)
End DoDot:1
IF IBQUIT=1
DO ENQ
QUIT
+62 ;
+63 ; Plan Selection prompt
SET IBAPL=$$SELP^IBCOPP1
+64 IF IBAPL<0
DO ENQ
QUIT
+65 ;
+66 ; IB*2.0*549 - Inactive/Active/Both Insurance Company Plan look-up filter
+67 ; Only ask if user didn't select all Group Plan
+68 SET IBAIPA=2
+69 if 'IBAPL
SET IBAIPA=$$SELPA^IBCOPP1
+70 IF IBAIPA<0
DO ENQ
QUIT
+71 ;
+72 ; All Insurance Companies, All Plans, skip to device prompt
+73 IF IBAI
IF IBAPL
Begin DoDot:1
+74 ; Report or CSV output
SET IBAO=$$OUT^IBCOPP1
+75 IF IBAO<0
DO ENQ
QUIT
+76 DO DEVICE
End DoDot:1
QUIT
+77 ;
+78 ; Obtain Plans for selected or All Insurance Companies
+79 DO START
+80 IF IBQUIT
DO ENQ
QUIT
+81 IF '$DATA(^TMP("IBINC",$JOB))
Begin DoDot:1
+82 WRITE !!,*7,"No plans selected!"
+83 DO ENQ
End DoDot:1
QUIT
+84 ;
+85 ; Report or CSV output
SET IBAO=$$OUT^IBCOPP1
+86 DO DEVICE
+87 QUIT
+88 ;
DEVICE ; Ask user to select device
+1 ;
+2 NEW I,POP
+3 IF IBAO'="E"
Begin DoDot:1
+4 WRITE !!,"*** You will need a 132 column printer for this report. ***",!
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 WRITE !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
+7 WRITE !,"of the data saved to the file, please enter ""0;256;99999"" at the ""DEVICE:"""
+8 WRITE !,"prompt.",!
End DoDot:1
+9 SET %ZIS="QM"
+10 DO ^%ZIS
+11 IF POP
DO ENQ
QUIT
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 SET ZTRTN="^IBCOPP2"
SET ZTDESC="IB - LIST OF PLANS BY INSURANCE COMPANY"
+14 FOR I="^TMP(""IBINC"",$J,","IBAPA","IBAI","IBAPL","IBAO"
SET ZTSAVE(I)=""
+15 DO ^%ZTLOAD
+16 KILL IO("Q")
+17 DO HOME^%ZIS
+18 WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued as task #"_ZTSK_".",1:"Unable to queue this job.")
+19 KILL ZTSK,IO("Q")
+20 DO ENQ
End DoDot:1
QUIT
+21 ;
+22 ; Compile and print report
+23 USE IO
+24 DO ^IBCOPP2
+25 ;
ENQ ;
+1 KILL A,DIRUT,DIROUT,DUOUT,DTOUT,IBAO,IBAI,IBAIA,IBAIPA,IBAPA,IBAPL,IBQUIT,X,Y
+2 KILL ^TMP("IBCNILKA",$JOB),^TMP("IBINC",$JOB)
+3 QUIT
+4 ;
START ; Gather plans for all selected companies.
+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 ; IBAPL - 0 - Whether some or all ins. co's., user selects plans (may be
+10 ; all for certain companies, some for other companies)
+11 ; 1 - Whether some or all ins. co's., run report for all plans
+12 ; associated with those co's.
+13 SET (IBCT,IBQUIT)=0
+14 IF IBAPL
DO STARTQ
QUIT
+15 ;
+16 ; Gather all Insurance Companies if required
+17 IF IBAI
Begin DoDot:1
+18 NEW INACT
+19 SET A=0
+20 FOR
SET A=$ORDER(^IBA(355.3,"B",A))
if 'A
QUIT
Begin DoDot:2
+21 if $GET(^DIC(36,A,0))=""
QUIT
+22 ; Is the Insurance Company Inactive?
SET INACT=+$$GET1^DIQ(36,A_",",.05,"I")
+23 ; IB*2.0*549 Only include Active Ins. Cos.
IF INACT
IF IBAIA=1
QUIT
+24 ; IB*2.0*549 Only include Inactive Ins. Cos.
IF 'INACT
IF IBAIA=0
QUIT
+25 SET ^TMP("IBINC",$JOB,$EXTRACT($PIECE($GET(^DIC(36,A,0)),"^"),1,25),A)=""
End DoDot:2
End DoDot:1
+26 ;
+27 ; Gather plans for selected Insurance Companies
+28 SET IBIC=""
+29 FOR
SET IBIC=$ORDER(^TMP("IBINC",$JOB,IBIC))
if IBIC=""!IBQUIT
QUIT
Begin DoDot:1
+30 SET IBCNS=""
+31 FOR
SET IBCNS=$ORDER(^TMP("IBINC",$JOB,IBIC,IBCNS))
if IBCNS=""!(IBQUIT)
QUIT
Begin DoDot:2
+32 SET IBCT=IBCT+1
+33 WRITE !!,"Insurance Company # "_IBCT_": "_IBIC
+34 DO OK^IBCNSM3
+35 if IBQUIT
QUIT
+36 IF 'IBOK
KILL ^TMP("IBINC",$JOB,IBIC,IBCNS)
SET IBAI=0
QUIT
+37 WRITE " ...building a list of plans..."
+38 KILL IBSEL,^TMP($JOB,"IBSEL")
+39 ;
+40 ; IB*2.0*549 - Add Active/Inactive/Both Plan filter
+41 SET XX=$SELECT(IBAIPA=0:2,IBAIPA=1:0,IBAIPA=2:1)
+42 DO LKP^IBCNSU2(IBCNS,1,1,.IBSEL,0,XX)
+43 if IBQUIT
QUIT
+44 IF '$ORDER(^TMP($JOB,"IBSEL",0))
Begin DoDot:3
+45 KILL ^TMP("IBINC",$JOB,IBIC,IBCNS)
+46 SET IBAI=0
End DoDot:3
QUIT
+47 ;
+48 ; Set plans into an array
+49 SET IBPN=0
+50 FOR
SET IBPN=$ORDER(^TMP($JOB,"IBSEL",IBPN))
if 'IBPN
QUIT
Begin DoDot:3
+51 SET ^TMP("IBINC",$JOB,IBIC,IBCNS,IBPN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+52 ;
STARTQ ;
+1 KILL IBAO,IBCT,IBIC,IBJJ,IBLCT,IBCNS,IBOK,IBPN,IBSEL,^TMP($JOB,"IBSEL")
+2 QUIT
