IBCNGP ;ALB/CKB - REPORT OF COVERAGE LIMITATIONS (MAIN DRIVER/PROMPTS) ; 07-OCT-2021
;;2.0;INTEGRATED BILLING;**702**;21-MAR-94;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
; ICR #1519-For using the KERNEL routine XUTMDEVQ
;
; Prompt user to select report type, insurance companies, plans
; Output from User Selections:
; IBCNGP("IBOUT") E-EXCEL, R-REPORT
; IBCNGP("IBI") 0-Selected, 1-All Insurance Companies
; IBCNGP("IBIA") 0-Inactive, 1-Active, 2-Both Active and Inactive Insurance Companies
; IBCNGP("IBIP") 0-Selected, 1-All Group Plans
; IBCNGP("IBIPA") 0-Inactive, 1-Active, 2-Both Active and Inactive Group Plans
; IBCNGP("IBIGN") 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
; IBCNGP("IBFIL") A^B^C where"
; A - 1-Begin with, 2-Contains, 3-Range
; B - A=1 Begin with text, A=2 Contains text, A=3 Range start text
; C - only if A=3 Range End text
; IBCNGP("IBICS") 1-Covered, 2-Not Covered, 3-Conditional
; 4-By Default (blank status), 5-All Coverage Statuses
;
Q ; Must call EN
;
EN ;Main Entry point
; Initialize variables
N A,DIRUT,DIROUT,DUOUT,DTOUT,FILTER,GIEN,I,IBCNGP,IBCNGPRTN,IBQUIT,IIEN,INACT
N NGFLG,NGFND,POP,STOP,X,Y,ZTDESC,ZTDEXC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSTOP,%ZIS
K ^TMP("IBCNGP",$J)
S (IBQUIT,STOP)=0
S IBCNGPRTN="IBCNGP"
;
; Describe report
W @IOF
W !,"Coverage Limitations Report",!
W !,"This report will generate a list of coverage limitations by company and"
W !,"group. You must select one, multiple, or all insurance companies and anywhere"
W !,"from one to all of the plans under each company. The results can be filtered"
W !,"by coverage limitation status."
;
C10 ; All/Selected Insurance Companies
D SELI I STOP G EXIT
;
C20 ; Inactive/Active/Both Insurance Company look-up filter
D SELA I STOP G EXIT
;
C30 ; Insurance Company look-up listman template
; Allow user selection of Insurance Companies
I 'IBCNGP("IBI") D
. N IBCNS,INSCT,INSNAME
. D EN^IBCNILK(IBCNGP("IBIA"))
. I '$D(^TMP("IBCNILKA",$J)) S IBQUIT=1 Q ; No Insurance Companies selected
. S INSCT=0
. S IBCNS="" F S IBCNS=$O(^TMP("IBCNILKA",$J,IBCNS)) Q:IBCNS="" D
. . S INSCT=INSCT+1
. . ; Add SELECTED Insurance Companies, add to ^TMP("IBCNGP")
. . S ^TMP("IBCNGP",$J,"INS",INSCT)=IBCNS
. K ^TMP("IBCNILKA",$J)
;
I IBQUIT W !!,"** No Insurance Companies selected! **",!! S DIR(0)="E" D ^DIR K DIR G EXIT
;
; If ALL Insurance Companies, add to ^TMP("IBCNGP")
I IBCNGP("IBI") D
. S INSCT=0
. S IIEN=0 F S IIEN=$O(^DIC(36,IIEN)) Q:'IIEN D
. . ; Is the Insurance Company Inactive?
. . S INACT=+$$GET1^DIQ(36,IIEN_",",.05,"I") ;1=Inactive, 0=Active
. . I 'INACT,'IBCNGP("IBIA") Q ; Ins Company is Active and looking for Inactive only
. . I INACT,(IBCNGP("IBIA")=1) Q ; Ins Company is Inactive and looking for Active only
. . S INSCT=INSCT+1
. . S ^TMP("IBCNGP",$J,"INS",INSCT)=IIEN
;
G10 ; All/Selected Group Plans
D SELG I STOP G EXIT
; No Groups found (NGFND=1), type enter to continue and exit
I $G(NGFND)=1 S DIR(0)="E" D ^DIR K DIR G EXIT
;
G20 ; Inactive/Active/Both Group Plan filter
D SELGA I STOP G EXIT
;
G30 ; Group Name/Group Number/Both filter
D SELGN I STOP G EXIT
;
G40 ; Group(s)that Begin/Contain/Range XXX
S FILTER=$$SELFILT^IBCNGP()
I +FILTER<0 S STOP=1 I STOP G EXIT
S IBCNGP("IBFIL")=FILTER
;
; Obtain Groups Plans for selected or All Insurance Companies
D START
I '$D(^TMP("IBCNGP",$J,"INS")) W !!,"** No plans selected! **",!! S DIR(0)="E" D ^DIR K DIR G EXIT
I STOP G EXIT
;
G50 ; Group Coverage Status filter
D SELCS I STOP G EXIT
;
O10 ; Report or CSV output
D OUT I STOP G EXIT
D DEVICE
;
EXIT ;
K ^TMP("IBCNILKA",$J)
K ^TMP("IBCNGP",$J)
Q
;
DEVICE ;
N I,POP
W !!,"We recommend you queue this report as it will take awhile."
I IBCNGP("IBOUT")="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.",!
I IBCNGP("IBOUT")="R" D
. W !!,"*** You will need a 132 column printer for this report. ***",!
;
; IBCNGP = Array of Params
N POP,ZTDESC,ZTRTN,ZTSAVE
S ZTRTN="COMPILE^IBCNGP1(""IBCNGP"",.IBCNGP)"
S ZTDESC="CV - REPORT OF COVERAGE LIMITATION"
S ZTSAVE("^TMP(""IBCNGP"",$J,")=""
S ZTSAVE("IBCNGP(")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q") ; ICR # 1519
;
ENQ ;
K ^TMP("IBCNILKA",$J)
K ^TMP("IBCNGP",$J)
Q
;
START ; Group Plan look-up listman template
; Allow user selection of one or more Group Plans
; Input: IBCNGP("IBIP") 0-Selected, 1-All Group Plans
; IBCNGP("IBIPA") 0-Inactive, 1-Active, 2-Both Active and Inactive Group Plans
; IBCNGP("IBIGN") 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
; IBCNGP("IBFIL") A^B^C where"
; A - 1-Begin with, 2-Contains, 3-Range
; B - A=1 Begin with text, A=2 Contains text, A=3 Range start text
; C - only if A=3 Range End text
N A,B,CT,GCT,GIEN,IBCT,IBOK,IBSEL,PLANOK,SORT
S IBQUIT=0
;
;If Selected Group Plans
I 'IBCNGP("IBIP") D
. D SORT
. S CT=0
. S A="" F S A=$O(SORT(A)) Q:A=""!IBQUIT D
. . S B="" F S B=$O(SORT(A,B)) Q:B=""!IBQUIT D
. . . D GETGRP
STARTQ ;
K ^TMP($J,"IBSEL")
Q
;
GETGRP ; Gather Group Plans by Insurance Companies
S IBCT=SORT(A,B)
S CT=CT+1
W !!,"Insurance Company # "_CT_": "_A
D OK^IBCNSM3
I IBQUIT S STOP=1 Q
I 'IBOK K ^TMP("IBCNGP",$J,"INS",IBCT) Q
W " ...building a list of plans..."
K IBSEL,^TMP($J,"IBSEL")
;
; The Groups listed will be filtered the based on the users selections above
D LKP^IBCNSU21(B,1,IBCNGP("IBIPA"),IBCNGP("IBIGN"),IBCNGP("IBFIL"))
I IBQUIT S STOP=1 Q
I $G(^TMP($J,"IBSEL",0))=0 D
. K SORT(A,B),^TMP("IBCNGP",$J,"INS",IBCT)
. S IBCNGP("IBAI")=0
;
; Add SELECTED Plans, add to ^TMP("IBCNGP")
I $G(^TMP($J,"IBSEL",0))>0 D
. S GCT=0
. S GIEN=0 F S GIEN=$O(^TMP($J,"IBSEL",GIEN)) Q:'GIEN D
. . S GCT=GCT+1
. . S ^TMP("IBCNGP",$J,"INS",IBCT,"GRP",GCT)=GIEN
Q
;
SORT ; Sort the currently selected insurance companies into name order
N IBCT,IIEN,INSNAME
;
S IBCT=""
F S IBCT=$O(^TMP("IBCNGP",$J,"INS",IBCT)) Q:IBCT=""!IBQUIT D
. S IIEN=^TMP("IBCNGP",$J,"INS",IBCT)
. S INSNAME=$$GET1^DIQ(36,IIEN,.01)
. ;IB*702/CKB - if the Insurance Company name doesn't exist, quit to prevent VistA crash
. I INSNAME="" Q
. S SORT(INSNAME,IIEN)=IBCT
Q
;
;======================================Prompts==========================
SELI ; Prompt user to select all or subset of insurance companies
; Count insurance companies with plans
; Returns: 0 - User selects insurance companies
; 1 - Run report for all insurance companies with plans
; STOP=1 - No selection made
;
N A,B
S (A,B)=0
F S A=$O(^IBA(355.3,"B",A)) Q:'A S B=B+1
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^1:List All "_B_" Ins. Companies;2:List Only Ins. Companies That You Select"
S DIR("A",1)="1 - List All "_B_" Ins. Companies"
S DIR("A",2)="2 - List Only Ins. Companies That You Select"
S DIR("A")=" SELECT 1 or 2: "
S DIR("?",1)="Enter a code from the list: 1 or 2. Only insurance"
S DIR("?")="companies with one or more plans can be selected."
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S STOP=1 G SELIQ
S IBCNGP("IBI")=(+Y=1) K Y
SELIQ ;
Q
;
SELA ; Prompt user to select Active/Inactive/Both Insurance Companies
; Returns: 0 - INACTIVE Insurance Companies Only
; 1 - ACTIVE Insurance Companies Only
; 2 - Both ACTIVE and INACTIVE Insurance Companies
; STOP=1 - No selection made
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^1:ACTIVE;2:INACTIVE;3:BOTH"
S DIR("A")=" Select 1 or 2 or 3: "
S DIR("A",1)="1 - Select ACTIVE Insurance Companies"
S DIR("A",2)="2 - Select INACTIVE Insurance Companies"
S DIR("A",3)="3 - Select BOTH"
S DIR("?",1)=" 1 - Only allow selection of ACTIVE Insurance Companies"
S DIR("?",2)=" 2 - Only allow selection of INACTIVE Insurance Companies"
S DIR("?")=" 3 - Allow selection of ACTIVE and INACTIVE Insurance Companies"
S DIR("B")=1
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S STOP=1 G SELAQ
S IBCNGP("IBIA")=$S(Y=1:1,Y=2:0,1:2)
SELAQ ;
Q
;
SELG ; Prompt user to select all or subset of group plans
; Count of group plans
; Returns: 0 - Selected Group Plans
; 1 - All Group Plans
; STOP=1 - No selection made
;
N A,A0,A1,CT,INACT
;
; Get count of Group Plans from Insurance Company(s), ALL or Selected
S (NGFLG,NGFND)=0
S CT=0
S A0=0 F S A0=$O(^TMP("IBCNGP",$J,"INS",A0)) Q:A0="" D
. S A=^TMP("IBCNGP",$J,"INS",A0)
. I '$D(^IBA(355.3,"B",A)) S NGFLG=1 Q
. S B=0 F S B=$O(^IBA(355.3,"B",A,B)) Q:'B D
. . S CT=CT+1
;
; If there are no groups for the selected Ins Company(s),display the following and set NGFND=1
I 'IBCNGP("IBI"),CT=0 D Q
. W !!,"The selected Company(s) does not contain any Groups",!!
. S NGFND=1,IBCNGP("IBIP")=0
;
; If there are No Groups found when one or more Ins Company(s) are selected
; display the following message
I NGFLG W !!,"Some Selected Companies do not contain groups and will not display on the report"
;
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^1:List All "_CT_" Group Plans;2:List Only Group Plans That You Select"
S DIR("A",1)="1 - List All "_CT_" Group Plans"
S DIR("A",2)="2 - List Only Group Plans That You Select"
S DIR("A")=" SELECT 1 or 2: "
S DIR("?",1)="Enter a code from the list: 1 or 2."
S DIR("?")="One or more group plans can be selected."
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S STOP=1 G SELGQ
S IBCNGP("IBIP")=(+Y=1) K Y
SELGQ ;
Q
;
SELGA ; Prompt user to select Active/Inactive/Both Group Plans
; Input: None
; Returns: 0 - INACTIVE Group Plans Only
; 1 - ACTIVE Group Plans Only
; 2 - Both ACTIVE and INACTIVE Group Plans
; -1 - No selection made
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^1:ACTIVE;2:INACTIVE;3:BOTH"
S DIR("A")=" Select 1 or 2 or 3: "
S DIR("A",1)="1 - Select ACTIVE Group Plans"
S DIR("A",2)="2 - Select INACTIVE Group Plans"
S DIR("A",3)="3 - Select BOTH"
S DIR("?",1)=" 1 - Only allow selection of ACTIVE Group Plans"
S DIR("?",2)=" 2 - Only allow selection of INACTIVE Group Plans"
S DIR("?")=" 3 - Allow selection of ACTIVE and INACTIVE Group Plans"
S DIR("B")=1
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S STOP=1 G SELGAQ
S IBCNGP("IBIPA")=$S(Y=1:1,Y=2:0,1:2)
SELGAQ ;
Q
;
SELGN ; Prompt user to select Group Name/Group Number/Both filter
; Returns: 1 - Group Name
; 2 - Group Number
; 3 - Both Group Name and Group Number
; -1 - No selection made
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^1:GROUP NAME;2:GROUP NUMBER;3:BOTH"
S DIR("A")=" Select 1 or 2 or 3: "
S DIR("A",1)="1 - Select GROUP NAME"
S DIR("A",2)="2 - Select GROUP NUMBER"
S DIR("A",3)="3 - Select BOTH"
S DIR("?",1)=" 1 - Only allow selection of GROUP NAME"
S DIR("?",2)=" 2 - Only allow selection of GROUP NUMBER"
S DIR("?")=" 3 - Allow selection of GROUP NAME and GROUP NUMBER"
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S STOP=1 G SELGNQ
S IBCNGP("IBIGN")=Y
SELGNQ ;
Q
;
SELFILT() ; Group Plan filter
; Returns: A^B^C Where:
; A - 1 - Search for Group(s) that begin with
; the specified text (case insensitive)
; 2 - Search for Group(s) that contain
; the specified text (case insensitive)
; 3 - Search for Group(s) in a specified
; range (inclusive, case insensitive)
; 4 - Search for Group(s) that are BLANK or null
; B - Begin with text if A=1, Contains Text if A=2 or
; the range start if A=3
; C - Range End text (only present when A=3)
; -1 if a valid filter was not selected
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,X,XX,Y
;
; First ask what kind of filter to use
W !
S DIR(0)="SA^1:Begins with;2:Contains;3:Range;4:Blank"
S DIR("A")=" Select 1, 2, 3 or 4: "
S DIR("A",1)="1 - Select Group(s) that Begin with: XXX"
S DIR("A",2)="2 - Select Group(s) that Contain: XXX"
S DIR("A",3)="3 - Select Group(s) in Range: XXX - YYY"
S DIR("A",4)="4 - Select Group(s) that are BLANK"
S DIR("?",1)="Select the type of filter to determine what Group(s) will be "
S DIR("?",2)="displayed as follows:"
S DIR("?",3)=" Begins with - Displays all group(s) that begin with the"
S DIR("?",4)=" specified text (inclusive, case insensitive)"
S DIR("?",5)=" Contains - Displays all group(s) that contain the"
S DIR("?",6)=" specified text (inclusive, case insensitive)"
S DIR("?",7)=" Range - Displays all group(s) within the "
S DIR("?",8)=" specified range (inclusive, case insensitive)"
S DIR("?")=" Blank - Displays all group(s) that are Blank or null"
S XX="1:Begins with;2:Contains;3:Range;4:Blank"
D ^DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q -1 ; No valid search selected
S FILTER=Y
I FILTER=4 G SELFILTQ
;
; Next ask for 'Begin with', 'Contains' or 'Range Start' text
W !
K DIR
S DIR(0)="F^1;30"
S XX=$S(FILTER=1:"that begin with",FILTER=2:"that contain",1:"Start of Range")
S DIR("A")=" Select Group(s) "_XX
I FILTER=1 D
. S DIR("?")="Enter the text that each Group(s) will begin with"
I FILTER=2 D
. S DIR("?")="Enter the text that each Group(s) will contain"
I FILTER=3 D
. S DIR("?")="Enter the starting range text"
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q -1 ; No valid search selected
S $P(FILTER,"^",2)=Y
Q:$P(FILTER,"^",1)'=3 FILTER
;
; Finally, ask for 'Range End' text if using a range filter
W !
K DIR
S DIR(0)="F^1;30"
S DIR("A")=" Select Group(s) End of Range"
S DIR("B")=$P(FILTER,"^",2)
S DIR("?")="Enter the ending Range text"
D ^DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q -1 ; No valid search selected
S $P(FILTER,"^",3)=Y
SELFILTQ ;
Q FILTER
;
;
SELCS ; Prompt user to select Coverage Status of the Group Plan(s)
; Input: None
; Returns: 1 - Coverage Status COVERED only
; 2 - Coverage Status NOT COVERED only
; 3 - Coverage Status CONDITIONAL only
; 4 - Coverage Status BY DEFAULT only
; 5 - ALL Coverage Statuses
; -1 - No selection made
;
N DIR,DIROUT,DIRUT,DTOUT,XX
W !
S DIR(0)="SA^1:COVERED;2:NOT COVERED;3:CONDITIONAL;4:BY DEFAULT(blank status);5:ALL"
S DIR("A")=" Select 1, 2, 3, 4 or 5: "
S DIR("A",1)="1 - Select Coverage Status COVERED"
S DIR("A",2)="2 - Select Coverage Status NOT COVERED"
S DIR("A",3)="3 - Select Coverage Status CONDITIONAL"
S DIR("A",4)="4 - Select Coverage Status BY DEFAULT (blank status)"
S DIR("A",5)="5 - Show all Coverage Statuses"
S DIR("?",1)="1 - Only allow selection of Coverage Status COVERED"
S DIR("?",2)="2 - Only allow selection of Coverage Status NOT COVERED"
S DIR("?",3)="3 - Only allow selection of Coverage Status CONDITIONAL"
S DIR("?",4)="4 - Only allow selection of Coverage Status BY DEFAULT (blank status)"
S DIR("?")="5 - Allow selection of All Coverage Statuses"
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S STOP=1 G SELCSQ
S IBCNGP("IBICS")=Y
SELCSQ ;
Q
;
OUT ; Prompt to allow users to select output format
; Returns: E - Output to excel
; R - Output to report
; STOP=1 - No Selection made
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
S DIR("?",1)="Select 'E' to create CSV output for import into Excel."
S DIR("?")="Select 'R' to create a standard report."
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S STOP=1 G OUTQ
S IBCNGP("IBOUT")=Y
OUTQ ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNGP 16465 printed Apr 09, 2024@21:12:27 Page 2
IBCNGP ;ALB/CKB - REPORT OF COVERAGE LIMITATIONS (MAIN DRIVER/PROMPTS) ; 07-OCT-2021
+1 ;;2.0;INTEGRATED BILLING;**702**;21-MAR-94;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; ICR #1519-For using the KERNEL routine XUTMDEVQ
+5 ;
+6 ; Prompt user to select report type, insurance companies, plans
+7 ; Output from User Selections:
+8 ; IBCNGP("IBOUT") E-EXCEL, R-REPORT
+9 ; IBCNGP("IBI") 0-Selected, 1-All Insurance Companies
+10 ; IBCNGP("IBIA") 0-Inactive, 1-Active, 2-Both Active and Inactive Insurance Companies
+11 ; IBCNGP("IBIP") 0-Selected, 1-All Group Plans
+12 ; IBCNGP("IBIPA") 0-Inactive, 1-Active, 2-Both Active and Inactive Group Plans
+13 ; IBCNGP("IBIGN") 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
+14 ; IBCNGP("IBFIL") A^B^C where"
+15 ; A - 1-Begin with, 2-Contains, 3-Range
+16 ; B - A=1 Begin with text, A=2 Contains text, A=3 Range start text
+17 ; C - only if A=3 Range End text
+18 ; IBCNGP("IBICS") 1-Covered, 2-Not Covered, 3-Conditional
+19 ; 4-By Default (blank status), 5-All Coverage Statuses
+20 ;
+21 ; Must call EN
QUIT
+22 ;
EN ;Main Entry point
+1 ; Initialize variables
+2 NEW A,DIRUT,DIROUT,DUOUT,DTOUT,FILTER,GIEN,I,IBCNGP,IBCNGPRTN,IBQUIT,IIEN,INACT
+3 NEW NGFLG,NGFND,POP,STOP,X,Y,ZTDESC,ZTDEXC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSTOP,%ZIS
+4 KILL ^TMP("IBCNGP",$JOB)
+5 SET (IBQUIT,STOP)=0
+6 SET IBCNGPRTN="IBCNGP"
+7 ;
+8 ; Describe report
+9 WRITE @IOF
+10 WRITE !,"Coverage Limitations Report",!
+11 WRITE !,"This report will generate a list of coverage limitations by company and"
+12 WRITE !,"group. You must select one, multiple, or all insurance companies and anywhere"
+13 WRITE !,"from one to all of the plans under each company. The results can be filtered"
+14 WRITE !,"by coverage limitation status."
+15 ;
C10 ; All/Selected Insurance Companies
+1 DO SELI
IF STOP
GOTO EXIT
+2 ;
C20 ; Inactive/Active/Both Insurance Company look-up filter
+1 DO SELA
IF STOP
GOTO EXIT
+2 ;
C30 ; Insurance Company look-up listman template
+1 ; Allow user selection of Insurance Companies
+2 IF 'IBCNGP("IBI")
Begin DoDot:1
+3 NEW IBCNS,INSCT,INSNAME
+4 DO EN^IBCNILK(IBCNGP("IBIA"))
+5 ; No Insurance Companies selected
IF '$DATA(^TMP("IBCNILKA",$JOB))
SET IBQUIT=1
QUIT
+6 SET INSCT=0
+7 SET IBCNS=""
FOR
SET IBCNS=$ORDER(^TMP("IBCNILKA",$JOB,IBCNS))
if IBCNS=""
QUIT
Begin DoDot:2
+8 SET INSCT=INSCT+1
+9 ; Add SELECTED Insurance Companies, add to ^TMP("IBCNGP")
+10 SET ^TMP("IBCNGP",$JOB,"INS",INSCT)=IBCNS
End DoDot:2
+11 KILL ^TMP("IBCNILKA",$JOB)
End DoDot:1
+12 ;
+13 IF IBQUIT
WRITE !!,"** No Insurance Companies selected! **",!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EXIT
+14 ;
+15 ; If ALL Insurance Companies, add to ^TMP("IBCNGP")
+16 IF IBCNGP("IBI")
Begin DoDot:1
+17 SET INSCT=0
+18 SET IIEN=0
FOR
SET IIEN=$ORDER(^DIC(36,IIEN))
if 'IIEN
QUIT
Begin DoDot:2
+19 ; Is the Insurance Company Inactive?
+20 ;1=Inactive, 0=Active
SET INACT=+$$GET1^DIQ(36,IIEN_",",.05,"I")
+21 ; Ins Company is Active and looking for Inactive only
IF 'INACT
IF 'IBCNGP("IBIA")
QUIT
+22 ; Ins Company is Inactive and looking for Active only
IF INACT
IF (IBCNGP("IBIA")=1)
QUIT
+23 SET INSCT=INSCT+1
+24 SET ^TMP("IBCNGP",$JOB,"INS",INSCT)=IIEN
End DoDot:2
End DoDot:1
+25 ;
G10 ; All/Selected Group Plans
+1 DO SELG
IF STOP
GOTO EXIT
+2 ; No Groups found (NGFND=1), type enter to continue and exit
+3 IF $GET(NGFND)=1
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EXIT
+4 ;
G20 ; Inactive/Active/Both Group Plan filter
+1 DO SELGA
IF STOP
GOTO EXIT
+2 ;
G30 ; Group Name/Group Number/Both filter
+1 DO SELGN
IF STOP
GOTO EXIT
+2 ;
G40 ; Group(s)that Begin/Contain/Range XXX
+1 SET FILTER=$$SELFILT^IBCNGP()
+2 IF +FILTER<0
SET STOP=1
IF STOP
GOTO EXIT
+3 SET IBCNGP("IBFIL")=FILTER
+4 ;
+5 ; Obtain Groups Plans for selected or All Insurance Companies
+6 DO START
+7 IF '$DATA(^TMP("IBCNGP",$JOB,"INS"))
WRITE !!,"** No plans selected! **",!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EXIT
+8 IF STOP
GOTO EXIT
+9 ;
G50 ; Group Coverage Status filter
+1 DO SELCS
IF STOP
GOTO EXIT
+2 ;
O10 ; Report or CSV output
+1 DO OUT
IF STOP
GOTO EXIT
+2 DO DEVICE
+3 ;
EXIT ;
+1 KILL ^TMP("IBCNILKA",$JOB)
+2 KILL ^TMP("IBCNGP",$JOB)
+3 QUIT
+4 ;
DEVICE ;
+1 NEW I,POP
+2 WRITE !!,"We recommend you queue this report as it will take awhile."
+3 IF IBCNGP("IBOUT")="E"
Begin DoDot:1
+4 WRITE !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
+5 WRITE !,"of the data saved to the file, please enter ""0;256;99999"" at the ""DEVICE:"""
+6 WRITE !,"prompt.",!
End DoDot:1
+7 IF IBCNGP("IBOUT")="R"
Begin DoDot:1
+8 WRITE !!,"*** You will need a 132 column printer for this report. ***",!
End DoDot:1
+9 ;
+10 ; IBCNGP = Array of Params
+11 NEW POP,ZTDESC,ZTRTN,ZTSAVE
+12 SET ZTRTN="COMPILE^IBCNGP1(""IBCNGP"",.IBCNGP)"
+13 SET ZTDESC="CV - REPORT OF COVERAGE LIMITATION"
+14 SET ZTSAVE("^TMP(""IBCNGP"",$J,")=""
+15 SET ZTSAVE("IBCNGP(")=""
+16 ; ICR # 1519
DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q")
+17 ;
ENQ ;
+1 KILL ^TMP("IBCNILKA",$JOB)
+2 KILL ^TMP("IBCNGP",$JOB)
+3 QUIT
+4 ;
START ; Group Plan look-up listman template
+1 ; Allow user selection of one or more Group Plans
+2 ; Input: IBCNGP("IBIP") 0-Selected, 1-All Group Plans
+3 ; IBCNGP("IBIPA") 0-Inactive, 1-Active, 2-Both Active and Inactive Group Plans
+4 ; IBCNGP("IBIGN") 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
+5 ; IBCNGP("IBFIL") A^B^C where"
+6 ; A - 1-Begin with, 2-Contains, 3-Range
+7 ; B - A=1 Begin with text, A=2 Contains text, A=3 Range start text
+8 ; C - only if A=3 Range End text
+9 NEW A,B,CT,GCT,GIEN,IBCT,IBOK,IBSEL,PLANOK,SORT
+10 SET IBQUIT=0
+11 ;
+12 ;If Selected Group Plans
+13 IF 'IBCNGP("IBIP")
Begin DoDot:1
+14 DO SORT
+15 SET CT=0
+16 SET A=""
FOR
SET A=$ORDER(SORT(A))
if A=""!IBQUIT
QUIT
Begin DoDot:2
+17 SET B=""
FOR
SET B=$ORDER(SORT(A,B))
if B=""!IBQUIT
QUIT
Begin DoDot:3
+18 DO GETGRP
End DoDot:3
End DoDot:2
End DoDot:1
STARTQ ;
+1 KILL ^TMP($JOB,"IBSEL")
+2 QUIT
+3 ;
GETGRP ; Gather Group Plans by Insurance Companies
+1 SET IBCT=SORT(A,B)
+2 SET CT=CT+1
+3 WRITE !!,"Insurance Company # "_CT_": "_A
+4 DO OK^IBCNSM3
+5 IF IBQUIT
SET STOP=1
QUIT
+6 IF 'IBOK
KILL ^TMP("IBCNGP",$JOB,"INS",IBCT)
QUIT
+7 WRITE " ...building a list of plans..."
+8 KILL IBSEL,^TMP($JOB,"IBSEL")
+9 ;
+10 ; The Groups listed will be filtered the based on the users selections above
+11 DO LKP^IBCNSU21(B,1,IBCNGP("IBIPA"),IBCNGP("IBIGN"),IBCNGP("IBFIL"))
+12 IF IBQUIT
SET STOP=1
QUIT
+13 IF $GET(^TMP($JOB,"IBSEL",0))=0
Begin DoDot:1
+14 KILL SORT(A,B),^TMP("IBCNGP",$JOB,"INS",IBCT)
+15 SET IBCNGP("IBAI")=0
End DoDot:1
+16 ;
+17 ; Add SELECTED Plans, add to ^TMP("IBCNGP")
+18 IF $GET(^TMP($JOB,"IBSEL",0))>0
Begin DoDot:1
+19 SET GCT=0
+20 SET GIEN=0
FOR
SET GIEN=$ORDER(^TMP($JOB,"IBSEL",GIEN))
if 'GIEN
QUIT
Begin DoDot:2
+21 SET GCT=GCT+1
+22 SET ^TMP("IBCNGP",$JOB,"INS",IBCT,"GRP",GCT)=GIEN
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
SORT ; Sort the currently selected insurance companies into name order
+1 NEW IBCT,IIEN,INSNAME
+2 ;
+3 SET IBCT=""
+4 FOR
SET IBCT=$ORDER(^TMP("IBCNGP",$JOB,"INS",IBCT))
if IBCT=""!IBQUIT
QUIT
Begin DoDot:1
+5 SET IIEN=^TMP("IBCNGP",$JOB,"INS",IBCT)
+6 SET INSNAME=$$GET1^DIQ(36,IIEN,.01)
+7 ;IB*702/CKB - if the Insurance Company name doesn't exist, quit to prevent VistA crash
+8 IF INSNAME=""
QUIT
+9 SET SORT(INSNAME,IIEN)=IBCT
End DoDot:1
+10 QUIT
+11 ;
+12 ;======================================Prompts==========================
SELI ; Prompt user to select all or subset of insurance companies
+1 ; Count insurance companies with plans
+2 ; Returns: 0 - User selects insurance companies
+3 ; 1 - Run report for all insurance companies with plans
+4 ; STOP=1 - No selection made
+5 ;
+6 NEW A,B
+7 SET (A,B)=0
+8 FOR
SET A=$ORDER(^IBA(355.3,"B",A))
if 'A
QUIT
SET B=B+1
+9 ;
+10 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+11 WRITE !
+12 SET DIR(0)="SA^1:List All "_B_" Ins. Companies;2:List Only Ins. Companies That You Select"
+13 SET DIR("A",1)="1 - List All "_B_" Ins. Companies"
+14 SET DIR("A",2)="2 - List Only Ins. Companies That You Select"
+15 SET DIR("A")=" SELECT 1 or 2: "
+16 SET DIR("?",1)="Enter a code from the list: 1 or 2. Only insurance"
+17 SET DIR("?")="companies with one or more plans can be selected."
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO SELIQ
+20 SET IBCNGP("IBI")=(+Y=1)
KILL Y
SELIQ ;
+1 QUIT
+2 ;
SELA ; Prompt user to select Active/Inactive/Both Insurance Companies
+1 ; Returns: 0 - INACTIVE Insurance Companies Only
+2 ; 1 - ACTIVE Insurance Companies Only
+3 ; 2 - Both ACTIVE and INACTIVE Insurance Companies
+4 ; STOP=1 - No selection made
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 WRITE !
+8 SET DIR(0)="SA^1:ACTIVE;2:INACTIVE;3:BOTH"
+9 SET DIR("A")=" Select 1 or 2 or 3: "
+10 SET DIR("A",1)="1 - Select ACTIVE Insurance Companies"
+11 SET DIR("A",2)="2 - Select INACTIVE Insurance Companies"
+12 SET DIR("A",3)="3 - Select BOTH"
+13 SET DIR("?",1)=" 1 - Only allow selection of ACTIVE Insurance Companies"
+14 SET DIR("?",2)=" 2 - Only allow selection of INACTIVE Insurance Companies"
+15 SET DIR("?")=" 3 - Allow selection of ACTIVE and INACTIVE Insurance Companies"
+16 SET DIR("B")=1
+17 DO ^DIR
KILL DIR
+18 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO SELAQ
+19 SET IBCNGP("IBIA")=$SELECT(Y=1:1,Y=2:0,1:2)
SELAQ ;
+1 QUIT
+2 ;
SELG ; Prompt user to select all or subset of group plans
+1 ; Count of group plans
+2 ; Returns: 0 - Selected Group Plans
+3 ; 1 - All Group Plans
+4 ; STOP=1 - No selection made
+5 ;
+6 NEW A,A0,A1,CT,INACT
+7 ;
+8 ; Get count of Group Plans from Insurance Company(s), ALL or Selected
+9 SET (NGFLG,NGFND)=0
+10 SET CT=0
+11 SET A0=0
FOR
SET A0=$ORDER(^TMP("IBCNGP",$JOB,"INS",A0))
if A0=""
QUIT
Begin DoDot:1
+12 SET A=^TMP("IBCNGP",$JOB,"INS",A0)
+13 IF '$DATA(^IBA(355.3,"B",A))
SET NGFLG=1
QUIT
+14 SET B=0
FOR
SET B=$ORDER(^IBA(355.3,"B",A,B))
if 'B
QUIT
Begin DoDot:2
+15 SET CT=CT+1
End DoDot:2
End DoDot:1
+16 ;
+17 ; If there are no groups for the selected Ins Company(s),display the following and set NGFND=1
+18 IF 'IBCNGP("IBI")
IF CT=0
Begin DoDot:1
+19 WRITE !!,"The selected Company(s) does not contain any Groups",!!
+20 SET NGFND=1
SET IBCNGP("IBIP")=0
End DoDot:1
QUIT
+21 ;
+22 ; If there are No Groups found when one or more Ins Company(s) are selected
+23 ; display the following message
+24 IF NGFLG
WRITE !!,"Some Selected Companies do not contain groups and will not display on the report"
+25 ;
+26 ;
+27 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+28 WRITE !
+29 SET DIR(0)="SA^1:List All "_CT_" Group Plans;2:List Only Group Plans That You Select"
+30 SET DIR("A",1)="1 - List All "_CT_" Group Plans"
+31 SET DIR("A",2)="2 - List Only Group Plans That You Select"
+32 SET DIR("A")=" SELECT 1 or 2: "
+33 SET DIR("?",1)="Enter a code from the list: 1 or 2."
+34 SET DIR("?")="One or more group plans can be selected."
+35 DO ^DIR
KILL DIR
+36 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO SELGQ
+37 SET IBCNGP("IBIP")=(+Y=1)
KILL Y
SELGQ ;
+1 QUIT
+2 ;
SELGA ; Prompt user to select Active/Inactive/Both Group Plans
+1 ; Input: None
+2 ; Returns: 0 - INACTIVE Group Plans Only
+3 ; 1 - ACTIVE Group Plans Only
+4 ; 2 - Both ACTIVE and INACTIVE Group Plans
+5 ; -1 - No selection made
+6 ;
+7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+8 WRITE !
+9 SET DIR(0)="SA^1:ACTIVE;2:INACTIVE;3:BOTH"
+10 SET DIR("A")=" Select 1 or 2 or 3: "
+11 SET DIR("A",1)="1 - Select ACTIVE Group Plans"
+12 SET DIR("A",2)="2 - Select INACTIVE Group Plans"
+13 SET DIR("A",3)="3 - Select BOTH"
+14 SET DIR("?",1)=" 1 - Only allow selection of ACTIVE Group Plans"
+15 SET DIR("?",2)=" 2 - Only allow selection of INACTIVE Group Plans"
+16 SET DIR("?")=" 3 - Allow selection of ACTIVE and INACTIVE Group Plans"
+17 SET DIR("B")=1
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO SELGAQ
+20 SET IBCNGP("IBIPA")=$SELECT(Y=1:1,Y=2:0,1:2)
SELGAQ ;
+1 QUIT
+2 ;
SELGN ; Prompt user to select Group Name/Group Number/Both filter
+1 ; Returns: 1 - Group Name
+2 ; 2 - Group Number
+3 ; 3 - Both Group Name and Group Number
+4 ; -1 - No selection made
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 WRITE !
+8 SET DIR(0)="SA^1:GROUP NAME;2:GROUP NUMBER;3:BOTH"
+9 SET DIR("A")=" Select 1 or 2 or 3: "
+10 SET DIR("A",1)="1 - Select GROUP NAME"
+11 SET DIR("A",2)="2 - Select GROUP NUMBER"
+12 SET DIR("A",3)="3 - Select BOTH"
+13 SET DIR("?",1)=" 1 - Only allow selection of GROUP NAME"
+14 SET DIR("?",2)=" 2 - Only allow selection of GROUP NUMBER"
+15 SET DIR("?")=" 3 - Allow selection of GROUP NAME and GROUP NUMBER"
+16 DO ^DIR
KILL DIR
+17 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO SELGNQ
+18 SET IBCNGP("IBIGN")=Y
SELGNQ ;
+1 QUIT
+2 ;
SELFILT() ; Group Plan filter
+1 ; Returns: A^B^C Where:
+2 ; A - 1 - Search for Group(s) that begin with
+3 ; the specified text (case insensitive)
+4 ; 2 - Search for Group(s) that contain
+5 ; the specified text (case insensitive)
+6 ; 3 - Search for Group(s) in a specified
+7 ; range (inclusive, case insensitive)
+8 ; 4 - Search for Group(s) that are BLANK or null
+9 ; B - Begin with text if A=1, Contains Text if A=2 or
+10 ; the range start if A=3
+11 ; C - Range End text (only present when A=3)
+12 ; -1 if a valid filter was not selected
+13 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,X,XX,Y
+14 ;
+15 ; First ask what kind of filter to use
+16 WRITE !
+17 SET DIR(0)="SA^1:Begins with;2:Contains;3:Range;4:Blank"
+18 SET DIR("A")=" Select 1, 2, 3 or 4: "
+19 SET DIR("A",1)="1 - Select Group(s) that Begin with: XXX"
+20 SET DIR("A",2)="2 - Select Group(s) that Contain: XXX"
+21 SET DIR("A",3)="3 - Select Group(s) in Range: XXX - YYY"
+22 SET DIR("A",4)="4 - Select Group(s) that are BLANK"
+23 SET DIR("?",1)="Select the type of filter to determine what Group(s) will be "
+24 SET DIR("?",2)="displayed as follows:"
+25 SET DIR("?",3)=" Begins with - Displays all group(s) that begin with the"
+26 SET DIR("?",4)=" specified text (inclusive, case insensitive)"
+27 SET DIR("?",5)=" Contains - Displays all group(s) that contain the"
+28 SET DIR("?",6)=" specified text (inclusive, case insensitive)"
+29 SET DIR("?",7)=" Range - Displays all group(s) within the "
+30 SET DIR("?",8)=" specified range (inclusive, case insensitive)"
+31 SET DIR("?")=" Blank - Displays all group(s) that are Blank or null"
+32 SET XX="1:Begins with;2:Contains;3:Range;4:Blank"
+33 DO ^DIR
+34 ; No valid search selected
IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+35 SET FILTER=Y
+36 IF FILTER=4
GOTO SELFILTQ
+37 ;
+38 ; Next ask for 'Begin with', 'Contains' or 'Range Start' text
+39 WRITE !
+40 KILL DIR
+41 SET DIR(0)="F^1;30"
+42 SET XX=$SELECT(FILTER=1:"that begin with",FILTER=2:"that contain",1:"Start of Range")
+43 SET DIR("A")=" Select Group(s) "_XX
+44 IF FILTER=1
Begin DoDot:1
+45 SET DIR("?")="Enter the text that each Group(s) will begin with"
End DoDot:1
+46 IF FILTER=2
Begin DoDot:1
+47 SET DIR("?")="Enter the text that each Group(s) will contain"
End DoDot:1
+48 IF FILTER=3
Begin DoDot:1
+49 SET DIR("?")="Enter the starting range text"
End DoDot:1
+50 DO ^DIR
KILL DIR
+51 ; No valid search selected
IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+52 SET $PIECE(FILTER,"^",2)=Y
+53 if $PIECE(FILTER,"^",1)'=3
QUIT FILTER
+54 ;
+55 ; Finally, ask for 'Range End' text if using a range filter
+56 WRITE !
+57 KILL DIR
+58 SET DIR(0)="F^1;30"
+59 SET DIR("A")=" Select Group(s) End of Range"
+60 SET DIR("B")=$PIECE(FILTER,"^",2)
+61 SET DIR("?")="Enter the ending Range text"
+62 DO ^DIR
+63 ; No valid search selected
IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+64 SET $PIECE(FILTER,"^",3)=Y
SELFILTQ ;
+1 QUIT FILTER
+2 ;
+3 ;
SELCS ; Prompt user to select Coverage Status of the Group Plan(s)
+1 ; Input: None
+2 ; Returns: 1 - Coverage Status COVERED only
+3 ; 2 - Coverage Status NOT COVERED only
+4 ; 3 - Coverage Status CONDITIONAL only
+5 ; 4 - Coverage Status BY DEFAULT only
+6 ; 5 - ALL Coverage Statuses
+7 ; -1 - No selection made
+8 ;
+9 NEW DIR,DIROUT,DIRUT,DTOUT,XX
+10 WRITE !
+11 SET DIR(0)="SA^1:COVERED;2:NOT COVERED;3:CONDITIONAL;4:BY DEFAULT(blank status);5:ALL"
+12 SET DIR("A")=" Select 1, 2, 3, 4 or 5: "
+13 SET DIR("A",1)="1 - Select Coverage Status COVERED"
+14 SET DIR("A",2)="2 - Select Coverage Status NOT COVERED"
+15 SET DIR("A",3)="3 - Select Coverage Status CONDITIONAL"
+16 SET DIR("A",4)="4 - Select Coverage Status BY DEFAULT (blank status)"
+17 SET DIR("A",5)="5 - Show all Coverage Statuses"
+18 SET DIR("?",1)="1 - Only allow selection of Coverage Status COVERED"
+19 SET DIR("?",2)="2 - Only allow selection of Coverage Status NOT COVERED"
+20 SET DIR("?",3)="3 - Only allow selection of Coverage Status CONDITIONAL"
+21 SET DIR("?",4)="4 - Only allow selection of Coverage Status BY DEFAULT (blank status)"
+22 SET DIR("?")="5 - Allow selection of All Coverage Statuses"
+23 DO ^DIR
KILL DIR
+24 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO SELCSQ
+25 SET IBCNGP("IBICS")=Y
SELCSQ ;
+1 QUIT
+2 ;
OUT ; Prompt to allow users to select output format
+1 ; Returns: E - Output to excel
+2 ; R - Output to report
+3 ; STOP=1 - No Selection made
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 WRITE !
+6 SET DIR(0)="SA^E:Excel;R:Report"
+7 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+8 SET DIR("B")="Report"
+9 SET DIR("?",1)="Select 'E' to create CSV output for import into Excel."
+10 SET DIR("?")="Select 'R' to create a standard report."
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO OUTQ
+13 SET IBCNGP("IBOUT")=Y
OUTQ ;
+1 QUIT
