IBCNOR1 ;AITC/DTG - PATIENT MISSING COVERAGE REPORT ;08/14/23
;;2.0;INTEGRATED BILLING;**771**;21-MAR-94;Build 26
;;Per VA Directive 6402, this routine should not be modified.
;
; ICR #1519-For using the KERNEL routine XUTMDEVQ
;
Q
EN ; entry point
;
; IBCNOR("IBI") = select INS 0 some, 1 all
; IBCNOR("IBIA") = only 1-Active Insurance Companies
; IBCNOR("IBIG") = 0-Selected, 1-All Group Plans
; IBCNOR("IBIGA")= only 1-Active Group Plans
; IBCNOR("IBIGN")= 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
; IBCNOR("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
; IBCNOR("IBOUT") E-EXCEL, R-REPORT
;
W !!,"This report allows the user to list patients who have an active medical"
W !,"policy/coverage and are missing an active pharmacy policy/coverage.",!!
;
N DIC,DIR,INACT,IBARRAY,IBB,IBCNOR,IBCNS,IBFILTER,IBLEVEL,IBI36,IBINAME
N IBINM,IBINSLNM,IBITYP,IBOK,IBOK1,IBQUIT,IBRF,IBRFU,IBRL,IBSORT,IBTMP,IBTYP,IBXTFEED
N IBRLU,IBSCR,IBSTOP,IIEN,INSCT,INSNAME,NGFLG,NGFND,POP,X,Y
S (IBSTOP,IBQUIT)=""
S IBCNOR("IBIA")=1 ;only active insurance companies
S IBCNOR("IBIGA")=1 ;only active group plans
;
Q10 ; ask ins
K IBARRAY
K ^TMP("IBCNOR",$J,"INS"),^TMP($J,"IBCNOR")
S IBSTOP=0 D SELI
I IBSTOP G EXIT
I 'IBCNOR("IBI") D
. N IBCNS,INSCT
. D EN^IBCNILK(1) ; active only
. I '$D(^TMP("IBCNILKA",$J)) S IBQUIT=1 Q ; No Insurance Companies selected
. K ^TMP($J,"IBCNOR","ILK") M ^TMP($J,"IBCNOR","ILK")=^TMP("IBCNILKA",$J)
. 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("IBCNOR")
. . S ^TMP("IBCNOR",$J,"INS",INSCT)=IBCNS
;
I IBQUIT W !!,"** No Insurance Companies selected! **",!! S DIR(0)="E" D ^DIR K DIR G EXIT
;
; If ALL Insurance Companies, add to ^TMP("IBCNOR")
I IBCNOR("IBI") D G Q50
. S INSCT=0
. S IBCNOR("IBIG")=1 ; default to all groups/plans of chosen insurance
. S IBCNOR("IBIGN")=3 ; default to both name and number for groups/plans
. S IBCNOR("IBFIL")="3^A^Z" ; default to groups in range from A to Z
;
Q20 ; ask group
;
S IBSTOP=0 D SELG I IBSTOP 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
;
I IBCNOR("IBIG") D G Q50 ; skip around when all groups/plans are selected
. S IBCNOR("IBIGN")=3 ; default to both name and number for groups/plans
. S IBCNOR("IBFIL")="3^A^Z" ; default to groups in range from A to Z
;
K ^TMP($J,"IBCNOR","ILK") M ^TMP($J,"IBCNOR","ILK")=^TMP("IBCNILKA",$J)
Q30 ; Group Name/Group Number/Both filter
S IBSTOP=0 D SELGN I IBSTOP G EXIT
;
Q40 ; type of group
; Group(s)that Begin/Contain/Range XXX
S (IBQUIT,IBSTOP)=0
S IBFILTER=$$SELFILT^IBCNOR1()
I +IBFILTER<0 S IBSTOP=1
I IBSTOP G EXIT
S IBCNOR("IBFIL")=IBFILTER
;
Q45 ; select groups if not all
;
;S (IBQUIT,IBSTOP)=0 I 'IBCNOR("IBIG") D I IBSTOP G:$$STOP EXIT G Q40
S (IBQUIT,IBSTOP)=0 I 'IBCNOR("IBIG") D I IBSTOP G EXIT
. ; loop through the insurance companies
. N IBI,IBJ,IBN,IBSORT
. K IBSORT
. S IBI=0 F S IBI=$O(^TMP("IBCNOR",$J,"INS",IBI)) Q:'IBI D
. . N IBNM
. . S IBN=$G(^TMP("IBCNOR",$J,"INS",IBI)),IBNM=$$GET1^DIQ(36,IBN,.01)
. . I IBNM="" Q
. . S IBSORT(IBNM,IBN)=IBI
. D BLDSELECT I IBQUIT!IBSTOP Q
. ; go through insurances if no plans selected
. N IBI,IBJ,IBN
. S IBI="",IBN=0 F S IBI=$O(^TMP("IBCNOR",$J,"INS",IBI)) Q:'IBI D Q:IBN
. . S IBJ="" F S IBJ=$O(^TMP("IBCNOR",$J,"INS",IBI,"GRP",IBJ)) Q:'IBJ S IBN=1
. I 'IBN S IBSTOP=1 D Q
. . W !," No Groups/Plans selected for the chosen insurances",!! S DIR(0)="E" D ^DIR K DIR
;
Q50 ; ask patient
;
S IBSTOP=0
D NR ;patient name range
I IBSTOP G EXIT
;
Q60 ; check if all and ask to proceed
S IBSTOP=0
I (IBCNOR("IBIG")&(IBCNOR("IBI"))&((IBRF="")&(IBRL="zzzzzz")!(IBRFU="A"&IBRLU="Z"))) D SELALL
I IBSTOP G EXIT
;
Q70 ; Report or CSV output
S IBSTOP=0 D OUT
I IBSTOP G EXIT
;
D DEVICE
;
EXIT ; quit
;
K ^TMP("IBCNOR",$J)
K ^TMP($J,"IBSEL")
;
Q
;
;
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 IBA,IBB,INACT
S (IBA,IBB)=0
F S IBA=$O(^IBA(355.3,"B",IBA)) Q:'IBA D
. S INACT=+$$GET1^DIQ(36,IBA_",",.05,"I") ;1=Inactive, 0=Active
. I 'INACT S IBB=IBB+1
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^1:List All "_IBB_" Active Ins. Companies;2:List Only Active Ins. Companies That You Select"
S DIR("A",1)="1 - List All "_IBB_" Active Ins. Companies"
S DIR("A",2)="2 - List Only Active 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 active 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 IBSTOP=1 G SELIQ
S IBCNOR("IBI")=(+Y=1) K Y
S IBCNOR("IBIA")=1
SELIQ ;
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 IBA,IBA0,IBCT,INACT,IBIN
;
S IBCNOR("IBIG")=1
S IBCNOR("IBIGA")=1
; Get count of Group Plans from Insurance Company(s), ALL or Selected
S (NGFLG,NGFND)=0
S IBCT=0
S IBA0=0,IBINSLNM="" F S IBA0=$O(^TMP("IBCNOR",$J,"INS",IBA0)) Q:'IBA0 D
. S IBA=^TMP("IBCNOR",$J,"INS",IBA0)
. S IBINSLNM=$$GET1^DIQ(36,IBA_",",.01)
. I '$D(^IBA(355.3,"B",IBA)) S NGFLG=1 Q
. S IBB=0 F S IBB=$O(^IBA(355.3,"B",IBA,IBB)) Q:'IBB D
. . S IBIN=+$$GET1^DIQ(355.3,IBB_",",.11,"I") I IBIN Q ; quit back if inactive flag set
. . S IBCT=IBCT+1
;
; If there are no groups for the selected Ins Company(s),display the following and set NGFND=1
I 'IBCNOR("IBI"),IBCT=0 D Q
. W !!,"The selected Company(s) does not contain any Groups",!!
. S NGFND=1,IBCNOR("IBIG")=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 "_IBCT_" Active Group Plans;2:List Only Active Group Plans That You Select"
S DIR("A",1)="1 - List All "_IBCT_" Active Group Plans"
S DIR("A",2)="2 - List Only Active 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 IBSTOP=1 G SELGQ
S IBCNOR("IBIG")=(+Y=1) K Y
S IBCNOR("IBIGA")=1
SELGQ ;
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 IBSTOP=1 G SELGNQ
S IBCNOR("IBIGN")=Y
SELGNQ ;
Q
;
NR ; Ask Name Range
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
NRR ;
W !!,"Enter Start With value or Press <ENTER> to start at the beginning of the list.",!
S DIR(0)="FO",DIR("A")="START WITH PATIENT NAME"
S DIR("?")="^D NRRHLP^IBCNOR1(""BEGIN"")"
D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBSTOP=1 Q
S IBRF=Y
S IBRFU=$$UP^XLFSTR(IBRF)
;
W !!,"Enter Go To value or Press <ENTER> to finish at the end of the list.",!
S DIR(0)="FO",DIR("A")="GO TO PATIENT NAME"
S DIR("?")="^D NRRHLP^IBCNOR1(""END"")"
D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBSTOP=1 Q
S:Y="" Y="zzzzzz" S IBRL=Y
S IBRLU=IBRL I IBRL'="zzzzzz" S IBRLU=$$UP^XLFSTR(IBRL)
I $G(IBRLU)']$G(IBRFU) W !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",! G NRR
Q
;
NRRHLP(IBLEVEL) ; ?? Help for the Range Prompt
W !!,?5,"Enter a value the Patient Name should ",IBLEVEL," with."
I IBLEVEL="BEGIN" W !,?5,"Press <ENTER> to start at the beginning of the list."
I IBLEVEL="END" W !,?5,"Press <ENTER> to finish at the end of the list."
Q
;
SELALL ; ask if user say run for all ins / groups / patients
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="Y",IBSTOP=0,DIR("B")="NO"
S DIR("A",1)="WARNING: You have selected to run this report for all insurance companies,"
S DIR("A",2)="all group plans, and all associated patients. In doing so, this report will"
S DIR("A",3)="take a long time to run."
S DIR("A",4)=" "
S DIR("A")="Do you want to continue"
S DIR("?")="Enter 'Y' to continue or 'N' to quit"
D ^DIR K DIR
I Y'="1" S Y=0
I Y=0!($D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)) S IBSTOP=1
SELALLQ ; back
Q
;
DEVICE ;
N I,POP,IBB
W !!,"We recommend you queue this report as it will take awhile."
I IBCNOR("IBOUT")="E" D
. W !!,"For CSV output, turn logging or capture on now.",!
;
; IBCNOR = Array of Params
N IBJOB,POP,ZTDESC,ZTRTN,ZTSAVE
S ZTRTN="COMPILE^IBCNOR1A(""IBCNOR"",.IBCNOR)"
S ZTDESC="PC - PATIENT MISSING COVERAGE REPORT"
S ZTSAVE("^TMP(""IBCNOR"",$J,")=""
S ZTSAVE("^TMP(""IBCNILKA"",$J,")=""
S IBJOB=$J
F IBB="IBCNOR(","IBJOB","IBRL","IBRLU","IBRF","IBRFU" S ZTSAVE(IBB)=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q") ; ICR # 1519
;
Q
ENQ ;
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 IBSTOP=1 G OUTQ
S IBCNOR("IBOUT")=Y
OUTQ ;
Q
;
STOP() ; Determine if user wants to exit out of the whole option
; Init vars
N DIR,X,Y,DIRUT
;
W !
S DIR(0)="Y"
S DIR("A")="Do you want to exit out of this option entirely"
S DIR("B")="YES"
S DIR("?",1)=" Enter YES to immediately exit out of this option."
S DIR("?")=" Enter NO to return to the previous question."
D ^DIR K DIR
I $D(DIRUT) S (IBSTOP,Y)=1 G STOPX
I 'Y S IBSTOP=0
;
STOPX ; STOP exit pt
Q Y
;
CHKINS(IBISN) ; check that insurance is allowed
;
N IBA,IBB,IBC,IBL
S IBOK=1
S INACT=+$$GET1^DIQ(36,IBISN_",",.05,"I") ;1=Inactive, 0=Active
S IBTYP=$$GET1^DIQ(36,IBISN_",",.13,"E")
; Is the Insurance Company Inactive?
I INACT S IBOK=0 Q ; Ins Company is Inactive and looking for Active only
; check on type
;Ins type is skipped
I IBTYP="MEDI-CAL" S IBOK=0 Q
I IBTYP="MEDICAID" S IBOK=0 Q
I IBTYP="TORT/FEASOR" S IBOK=0 Q
I IBTYP="VA SPECIAL CLASS" S IBOK=0 Q
I IBTYP="WORKERS' COMPENSATION" S IBOK=0 Q
I IBTYP="INDEMNITY" S IBOK=0 Q
I IBTYP="DISABILITY INCOME INSURANCE" S IBOK=0 Q
I IBTYP="SUBSTANCE ABUSE ONLY" S IBOK=0 Q
I IBTYP="MEDICARE" S IBOK=0 Q
Q
CHKNM(INSNAME) ; check name
; check on ins name
S INSNAME=$G(INSNAME) I INSNAME="" S IBOK=0 Q
N IBA,IBB,IBL,INSNAM
S IBOK=1,INSNAM=$$UP^XLFSTR(INSNAME)
I INSNAM["(WNR)" S IBOK=0 Q
I INSNAM["MCR" S IBOK=0 Q
I INSNAM["WNR" S IBOK=0 Q
I INSNAM["MEDICARE" S IBOK=0 Q
I INSNAM["MEDICAID" S IBOK=0 Q
I INSNAM["CAMP LEJEUNE" S IBOK=0 Q
I INSNAM["IVF" S IBOK=0 Q
I INSNAM["VHA DIRECTIVE 1029" S IBOK=0 Q
I INSNAM["CLAY HUNT" S IBOK=0 Q
I INSNAM["DEPARTMENT OF LABOR" S IBOK=0 Q
I INSNAM["REGIONAL COUNSEL" S IBOK=0 Q
;
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
I $P(FILTER,"^",1)'=3 G SELFILTQ
;
; 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
;
BLDSELECT ; go through selected insurances and get their groups
;
N GCT,GIEN,IBINSN,IBC,IBCO,IBINS,IBP,PLANDATA,PLANOK
K ^TMP($J,"IBCNOR","FND")
; user selected insurance companies
I 'IBCNOR("IBIG") D
. S IBINSN="",(IBQUIT,IBSTOP,IBCO)=0
. F S IBINSN=$O(IBSORT(IBINSN)) Q:IBINSN="" D I IBQUIT!(IBSTOP) Q
. . S IBINS=0 F S IBINS=$O(IBSORT(IBINSN,IBINS)) Q:'IBINS D I IBQUIT!(IBSTOP) Q
. . . S IBC=IBSORT(IBINSN,IBINS),IBCO=IBCO+1
. . . ;clear the plans before build
. . . K ^TMP("IBCNOR",$J,"INS",IBC,"GRP")
. . . ;
. . . S IBOK=0 W !!,"Insurance Company # "_IBCO_": "_IBINSN
. . . D OK^IBCNSM3
. . . I IBQUIT S IBSTOP=1 Q
. . . ;I 'IBOK K ^TMP("IBCNOR",$J,"INS",IBC) Q
. . . I 'IBOK Q
. . . W " ...building a list of plans..."
. . . ; The Groups listed will be filtered the based on the users selections above
. . . K ^TMP($J,"IBSEL")
. . . D LKP^IBCNSU21(IBINS,1,1,IBCNOR("IBIGN"),IBCNOR("IBFIL"))
. . . I IBQUIT S IBSTOP=1 Q
. . . I $G(^TMP($J,"IBSEL",0))=0 D
. . . . K ^TMP("IBCNOR",$J,"INS",IBC,"GRP")
. . . ;
. . . ; Add SELECTED Plans to ^TMP("IBCNOR")
. . . 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("IBCNOR",$J,"INS",IBC,"GRP",GCT)=GIEN
. K ^TMP($J,"IBCNOR","FND") M ^TMP($J,"IBCNOR","FND")=^TMP("IBCNOR",$J,"INS")
Q
;
BLDINSGR ; go through insurances and get their groups
;
N IBC,IBCT,GCT,GIEN,IBC,IBINS,IBP,PLANDATA,PLANOK
; user selected ALL insurance companies
S IBCT=0
I IBCNOR("IBIG") D
. S (IBC,GCT,IBINS,IBSTOP)=0
. F S IBC=$O(^TMP("IBCNOR",$J,"INS",IBC)) Q:'IBC S IBINS=$G(^TMP("IBCNOR",$J,"INS",IBC)) I IBINS D Q:IBSTOP
. . S GCT=0,IBP=0
. . F S IBP=$O(^IBA(355.3,"B",+IBINS,IBP)) Q:'IBP D
. . . S IBCT=IBCT+1 I $G(IOST)["C-"&(IBCT#1000=0) W "."
. . . K PLANDATA,PLANOK
. . . D GETS^DIQ(355.3,+IBP_",",".11;2.01;2.02","EI","PLANDATA")
. . . I $G(PLANDATA(355.3,IBP,.11,"I")) Q ; only get active plans
. . . ;
. . . S GCT=GCT+1
. . . S ^TMP("IBCNOR",$J,"INS",IBC,"GRP",GCT)=IBP
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNOR1 17396 printed Nov 22, 2024@17:26:08 Page 2
IBCNOR1 ;AITC/DTG - PATIENT MISSING COVERAGE REPORT ;08/14/23
+1 ;;2.0;INTEGRATED BILLING;**771**;21-MAR-94;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; ICR #1519-For using the KERNEL routine XUTMDEVQ
+5 ;
+6 QUIT
EN ; entry point
+1 ;
+2 ; IBCNOR("IBI") = select INS 0 some, 1 all
+3 ; IBCNOR("IBIA") = only 1-Active Insurance Companies
+4 ; IBCNOR("IBIG") = 0-Selected, 1-All Group Plans
+5 ; IBCNOR("IBIGA")= only 1-Active Group Plans
+6 ; IBCNOR("IBIGN")= 1-Group Name, 2-Group Number, 3-Both Group Name and Group Number
+7 ; IBCNOR("IBFIL")= A^B^C where"
+8 ; A - 1-Begin with, 2-Contains, 3-Range
+9 ; B - A=1 Begin with text, A=2 Contains text, A=3 Range start text
+10 ; C - only if A=3 Range End text
+11 ; IBCNOR("IBOUT") E-EXCEL, R-REPORT
+12 ;
+13 WRITE !!,"This report allows the user to list patients who have an active medical"
+14 WRITE !,"policy/coverage and are missing an active pharmacy policy/coverage.",!!
+15 ;
+16 NEW DIC,DIR,INACT,IBARRAY,IBB,IBCNOR,IBCNS,IBFILTER,IBLEVEL,IBI36,IBINAME
+17 NEW IBINM,IBINSLNM,IBITYP,IBOK,IBOK1,IBQUIT,IBRF,IBRFU,IBRL,IBSORT,IBTMP,IBTYP,IBXTFEED
+18 NEW IBRLU,IBSCR,IBSTOP,IIEN,INSCT,INSNAME,NGFLG,NGFND,POP,X,Y
+19 SET (IBSTOP,IBQUIT)=""
+20 ;only active insurance companies
SET IBCNOR("IBIA")=1
+21 ;only active group plans
SET IBCNOR("IBIGA")=1
+22 ;
Q10 ; ask ins
+1 KILL IBARRAY
+2 KILL ^TMP("IBCNOR",$JOB,"INS"),^TMP($JOB,"IBCNOR")
+3 SET IBSTOP=0
DO SELI
+4 IF IBSTOP
GOTO EXIT
+5 IF 'IBCNOR("IBI")
Begin DoDot:1
+6 NEW IBCNS,INSCT
+7 ; active only
DO EN^IBCNILK(1)
+8 ; No Insurance Companies selected
IF '$DATA(^TMP("IBCNILKA",$JOB))
SET IBQUIT=1
QUIT
+9 KILL ^TMP($JOB,"IBCNOR","ILK")
MERGE ^TMP($JOB,"IBCNOR","ILK")=^TMP("IBCNILKA",$JOB)
+10 SET INSCT=0
+11 SET IBCNS=""
FOR
SET IBCNS=$ORDER(^TMP("IBCNILKA",$JOB,IBCNS))
if IBCNS=""
QUIT
Begin DoDot:2
+12 SET INSCT=INSCT+1
+13 ; Add SELECTED Insurance Companies, add to ^TMP("IBCNOR")
+14 SET ^TMP("IBCNOR",$JOB,"INS",INSCT)=IBCNS
End DoDot:2
End DoDot:1
+15 ;
+16 IF IBQUIT
WRITE !!,"** No Insurance Companies selected! **",!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EXIT
+17 ;
+18 ; If ALL Insurance Companies, add to ^TMP("IBCNOR")
+19 IF IBCNOR("IBI")
Begin DoDot:1
+20 SET INSCT=0
+21 ; default to all groups/plans of chosen insurance
SET IBCNOR("IBIG")=1
+22 ; default to both name and number for groups/plans
SET IBCNOR("IBIGN")=3
+23 ; default to groups in range from A to Z
SET IBCNOR("IBFIL")="3^A^Z"
End DoDot:1
GOTO Q50
+24 ;
Q20 ; ask group
+1 ;
+2 SET IBSTOP=0
DO SELG
IF IBSTOP
GOTO EXIT
+3 ; No Groups found (NGFND=1), type enter to continue and exit
+4 IF $GET(NGFND)=1
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EXIT
+5 ;
+6 ; skip around when all groups/plans are selected
IF IBCNOR("IBIG")
Begin DoDot:1
+7 ; default to both name and number for groups/plans
SET IBCNOR("IBIGN")=3
+8 ; default to groups in range from A to Z
SET IBCNOR("IBFIL")="3^A^Z"
End DoDot:1
GOTO Q50
+9 ;
+10 KILL ^TMP($JOB,"IBCNOR","ILK")
MERGE ^TMP($JOB,"IBCNOR","ILK")=^TMP("IBCNILKA",$JOB)
Q30 ; Group Name/Group Number/Both filter
+1 SET IBSTOP=0
DO SELGN
IF IBSTOP
GOTO EXIT
+2 ;
Q40 ; type of group
+1 ; Group(s)that Begin/Contain/Range XXX
+2 SET (IBQUIT,IBSTOP)=0
+3 SET IBFILTER=$$SELFILT^IBCNOR1()
+4 IF +IBFILTER<0
SET IBSTOP=1
+5 IF IBSTOP
GOTO EXIT
+6 SET IBCNOR("IBFIL")=IBFILTER
+7 ;
Q45 ; select groups if not all
+1 ;
+2 ;S (IBQUIT,IBSTOP)=0 I 'IBCNOR("IBIG") D I IBSTOP G:$$STOP EXIT G Q40
+3 SET (IBQUIT,IBSTOP)=0
IF 'IBCNOR("IBIG")
Begin DoDot:1
+4 ; loop through the insurance companies
+5 NEW IBI,IBJ,IBN,IBSORT
+6 KILL IBSORT
+7 SET IBI=0
FOR
SET IBI=$ORDER(^TMP("IBCNOR",$JOB,"INS",IBI))
if 'IBI
QUIT
Begin DoDot:2
+8 NEW IBNM
+9 SET IBN=$GET(^TMP("IBCNOR",$JOB,"INS",IBI))
SET IBNM=$$GET1^DIQ(36,IBN,.01)
+10 IF IBNM=""
QUIT
+11 SET IBSORT(IBNM,IBN)=IBI
End DoDot:2
+12 DO BLDSELECT
IF IBQUIT!IBSTOP
QUIT
+13 ; go through insurances if no plans selected
+14 NEW IBI,IBJ,IBN
+15 SET IBI=""
SET IBN=0
FOR
SET IBI=$ORDER(^TMP("IBCNOR",$JOB,"INS",IBI))
if 'IBI
QUIT
Begin DoDot:2
+16 SET IBJ=""
FOR
SET IBJ=$ORDER(^TMP("IBCNOR",$JOB,"INS",IBI,"GRP",IBJ))
if 'IBJ
QUIT
SET IBN=1
End DoDot:2
if IBN
QUIT
+17 IF 'IBN
SET IBSTOP=1
Begin DoDot:2
+18 WRITE !," No Groups/Plans selected for the chosen insurances",!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
End DoDot:1
IF IBSTOP
GOTO EXIT
+19 ;
Q50 ; ask patient
+1 ;
+2 SET IBSTOP=0
+3 ;patient name range
DO NR
+4 IF IBSTOP
GOTO EXIT
+5 ;
Q60 ; check if all and ask to proceed
+1 SET IBSTOP=0
+2 IF (IBCNOR("IBIG")&(IBCNOR("IBI"))&((IBRF="")&(IBRL="zzzzzz")!(IBRFU="A"&IBRLU="Z")))
DO SELALL
+3 IF IBSTOP
GOTO EXIT
+4 ;
Q70 ; Report or CSV output
+1 SET IBSTOP=0
DO OUT
+2 IF IBSTOP
GOTO EXIT
+3 ;
+4 DO DEVICE
+5 ;
EXIT ; quit
+1 ;
+2 KILL ^TMP("IBCNOR",$JOB)
+3 KILL ^TMP($JOB,"IBSEL")
+4 ;
+5 QUIT
+6 ;
+7 ;
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 IBA,IBB,INACT
+7 SET (IBA,IBB)=0
+8 FOR
SET IBA=$ORDER(^IBA(355.3,"B",IBA))
if 'IBA
QUIT
Begin DoDot:1
+9 ;1=Inactive, 0=Active
SET INACT=+$$GET1^DIQ(36,IBA_",",.05,"I")
+10 IF 'INACT
SET IBB=IBB+1
End DoDot:1
+11 ;
+12 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+13 WRITE !
+14 SET DIR(0)="SA^1:List All "_IBB_" Active Ins. Companies;2:List Only Active Ins. Companies That You Select"
+15 SET DIR("A",1)="1 - List All "_IBB_" Active Ins. Companies"
+16 SET DIR("A",2)="2 - List Only Active Ins. Companies That You Select"
+17 SET DIR("A")=" SELECT 1 or 2: "
+18 SET DIR("?",1)="Enter a code from the list: 1 or 2. Only active insurance"
+19 SET DIR("?")="companies with one or more plans can be selected."
+20 DO ^DIR
KILL DIR
+21 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET IBSTOP=1
GOTO SELIQ
+22 SET IBCNOR("IBI")=(+Y=1)
KILL Y
+23 SET IBCNOR("IBIA")=1
SELIQ ;
+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 IBA,IBA0,IBCT,INACT,IBIN
+7 ;
+8 SET IBCNOR("IBIG")=1
+9 SET IBCNOR("IBIGA")=1
+10 ; Get count of Group Plans from Insurance Company(s), ALL or Selected
+11 SET (NGFLG,NGFND)=0
+12 SET IBCT=0
+13 SET IBA0=0
SET IBINSLNM=""
FOR
SET IBA0=$ORDER(^TMP("IBCNOR",$JOB,"INS",IBA0))
if 'IBA0
QUIT
Begin DoDot:1
+14 SET IBA=^TMP("IBCNOR",$JOB,"INS",IBA0)
+15 SET IBINSLNM=$$GET1^DIQ(36,IBA_",",.01)
+16 IF '$DATA(^IBA(355.3,"B",IBA))
SET NGFLG=1
QUIT
+17 SET IBB=0
FOR
SET IBB=$ORDER(^IBA(355.3,"B",IBA,IBB))
if 'IBB
QUIT
Begin DoDot:2
+18 ; quit back if inactive flag set
SET IBIN=+$$GET1^DIQ(355.3,IBB_",",.11,"I")
IF IBIN
QUIT
+19 SET IBCT=IBCT+1
End DoDot:2
End DoDot:1
+20 ;
+21 ; If there are no groups for the selected Ins Company(s),display the following and set NGFND=1
+22 IF 'IBCNOR("IBI")
IF IBCT=0
Begin DoDot:1
+23 WRITE !!,"The selected Company(s) does not contain any Groups",!!
+24 SET NGFND=1
SET IBCNOR("IBIG")=0
End DoDot:1
QUIT
+25 ;
+26 ; If there are No Groups found when one or more Ins Company(s) are selected
+27 ; display the following message
+28 IF NGFLG
WRITE !!,"Some Selected Companies do not contain groups and will not display on the report"
+29 ;
+30 ;
+31 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+32 WRITE !
+33 SET DIR(0)="SA^1:List All "_IBCT_" Active Group Plans;2:List Only Active Group Plans That You Select"
+34 SET DIR("A",1)="1 - List All "_IBCT_" Active Group Plans"
+35 SET DIR("A",2)="2 - List Only Active Group Plans That You Select"
+36 SET DIR("A")=" SELECT 1 or 2: "
+37 SET DIR("?",1)="Enter a code from the list: 1 or 2."
+38 SET DIR("?")="One or more group plans can be selected."
+39 DO ^DIR
KILL DIR
+40 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET IBSTOP=1
GOTO SELGQ
+41 SET IBCNOR("IBIG")=(+Y=1)
KILL Y
+42 SET IBCNOR("IBIGA")=1
SELGQ ;
+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 IBSTOP=1
GOTO SELGNQ
+18 SET IBCNOR("IBIGN")=Y
SELGNQ ;
+1 QUIT
+2 ;
NR ; Ask Name Range
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
NRR ;
+1 WRITE !!,"Enter Start With value or Press <ENTER> to start at the beginning of the list.",!
+2 SET DIR(0)="FO"
SET DIR("A")="START WITH PATIENT NAME"
+3 SET DIR("?")="^D NRRHLP^IBCNOR1(""BEGIN"")"
+4 DO ^DIR
IF ($DATA(DTOUT))!($DATA(DUOUT))
SET IBSTOP=1
QUIT
+5 SET IBRF=Y
+6 SET IBRFU=$$UP^XLFSTR(IBRF)
+7 ;
+8 WRITE !!,"Enter Go To value or Press <ENTER> to finish at the end of the list.",!
+9 SET DIR(0)="FO"
SET DIR("A")="GO TO PATIENT NAME"
+10 SET DIR("?")="^D NRRHLP^IBCNOR1(""END"")"
+11 DO ^DIR
IF ($DATA(DTOUT))!($DATA(DUOUT))
SET IBSTOP=1
QUIT
+12 if Y=""
SET Y="zzzzzz"
SET IBRL=Y
+13 SET IBRLU=IBRL
IF IBRL'="zzzzzz"
SET IBRLU=$$UP^XLFSTR(IBRL)
+14 IF $GET(IBRLU)']$GET(IBRFU)
WRITE !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",!
GOTO NRR
+15 QUIT
+16 ;
NRRHLP(IBLEVEL) ; ?? Help for the Range Prompt
+1 WRITE !!,?5,"Enter a value the Patient Name should ",IBLEVEL," with."
+2 IF IBLEVEL="BEGIN"
WRITE !,?5,"Press <ENTER> to start at the beginning of the list."
+3 IF IBLEVEL="END"
WRITE !,?5,"Press <ENTER> to finish at the end of the list."
+4 QUIT
+5 ;
SELALL ; ask if user say run for all ins / groups / patients
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="Y"
SET IBSTOP=0
SET DIR("B")="NO"
+4 SET DIR("A",1)="WARNING: You have selected to run this report for all insurance companies,"
+5 SET DIR("A",2)="all group plans, and all associated patients. In doing so, this report will"
+6 SET DIR("A",3)="take a long time to run."
+7 SET DIR("A",4)=" "
+8 SET DIR("A")="Do you want to continue"
+9 SET DIR("?")="Enter 'Y' to continue or 'N' to quit"
+10 DO ^DIR
KILL DIR
+11 IF Y'="1"
SET Y=0
+12 IF Y=0!($DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT))
SET IBSTOP=1
SELALLQ ; back
+1 QUIT
+2 ;
DEVICE ;
+1 NEW I,POP,IBB
+2 WRITE !!,"We recommend you queue this report as it will take awhile."
+3 IF IBCNOR("IBOUT")="E"
Begin DoDot:1
+4 WRITE !!,"For CSV output, turn logging or capture on now.",!
End DoDot:1
+5 ;
+6 ; IBCNOR = Array of Params
+7 NEW IBJOB,POP,ZTDESC,ZTRTN,ZTSAVE
+8 SET ZTRTN="COMPILE^IBCNOR1A(""IBCNOR"",.IBCNOR)"
+9 SET ZTDESC="PC - PATIENT MISSING COVERAGE REPORT"
+10 SET ZTSAVE("^TMP(""IBCNOR"",$J,")=""
+11 SET ZTSAVE("^TMP(""IBCNILKA"",$J,")=""
+12 SET IBJOB=$JOB
+13 FOR IBB="IBCNOR(","IBJOB","IBRL","IBRLU","IBRF","IBRFU"
SET ZTSAVE(IBB)=""
+14 ; ICR # 1519
DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q")
+15 ;
+16 QUIT
ENQ ;
+1 QUIT
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 IBSTOP=1
GOTO OUTQ
+13 SET IBCNOR("IBOUT")=Y
OUTQ ;
+1 QUIT
+2 ;
STOP() ; Determine if user wants to exit out of the whole option
+1 ; Init vars
+2 NEW DIR,X,Y,DIRUT
+3 ;
+4 WRITE !
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Do you want to exit out of this option entirely"
+7 SET DIR("B")="YES"
+8 SET DIR("?",1)=" Enter YES to immediately exit out of this option."
+9 SET DIR("?")=" Enter NO to return to the previous question."
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET (IBSTOP,Y)=1
GOTO STOPX
+12 IF 'Y
SET IBSTOP=0
+13 ;
STOPX ; STOP exit pt
+1 QUIT Y
+2 ;
CHKINS(IBISN) ; check that insurance is allowed
+1 ;
+2 NEW IBA,IBB,IBC,IBL
+3 SET IBOK=1
+4 ;1=Inactive, 0=Active
SET INACT=+$$GET1^DIQ(36,IBISN_",",.05,"I")
+5 SET IBTYP=$$GET1^DIQ(36,IBISN_",",.13,"E")
+6 ; Is the Insurance Company Inactive?
+7 ; Ins Company is Inactive and looking for Active only
IF INACT
SET IBOK=0
QUIT
+8 ; check on type
+9 ;Ins type is skipped
+10 IF IBTYP="MEDI-CAL"
SET IBOK=0
QUIT
+11 IF IBTYP="MEDICAID"
SET IBOK=0
QUIT
+12 IF IBTYP="TORT/FEASOR"
SET IBOK=0
QUIT
+13 IF IBTYP="VA SPECIAL CLASS"
SET IBOK=0
QUIT
+14 IF IBTYP="WORKERS' COMPENSATION"
SET IBOK=0
QUIT
+15 IF IBTYP="INDEMNITY"
SET IBOK=0
QUIT
+16 IF IBTYP="DISABILITY INCOME INSURANCE"
SET IBOK=0
QUIT
+17 IF IBTYP="SUBSTANCE ABUSE ONLY"
SET IBOK=0
QUIT
+18 IF IBTYP="MEDICARE"
SET IBOK=0
QUIT
+19 QUIT
CHKNM(INSNAME) ; check name
+1 ; check on ins name
+2 SET INSNAME=$GET(INSNAME)
IF INSNAME=""
SET IBOK=0
QUIT
+3 NEW IBA,IBB,IBL,INSNAM
+4 SET IBOK=1
SET INSNAM=$$UP^XLFSTR(INSNAME)
+5 IF INSNAM["(WNR)"
SET IBOK=0
QUIT
+6 IF INSNAM["MCR"
SET IBOK=0
QUIT
+7 IF INSNAM["WNR"
SET IBOK=0
QUIT
+8 IF INSNAM["MEDICARE"
SET IBOK=0
QUIT
+9 IF INSNAM["MEDICAID"
SET IBOK=0
QUIT
+10 IF INSNAM["CAMP LEJEUNE"
SET IBOK=0
QUIT
+11 IF INSNAM["IVF"
SET IBOK=0
QUIT
+12 IF INSNAM["VHA DIRECTIVE 1029"
SET IBOK=0
QUIT
+13 IF INSNAM["CLAY HUNT"
SET IBOK=0
QUIT
+14 IF INSNAM["DEPARTMENT OF LABOR"
SET IBOK=0
QUIT
+15 IF INSNAM["REGIONAL COUNSEL"
SET IBOK=0
QUIT
+16 ;
+17 QUIT
+18 ;
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
GOTO SELFILTQ
+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 ;
BLDSELECT ; go through selected insurances and get their groups
+1 ;
+2 NEW GCT,GIEN,IBINSN,IBC,IBCO,IBINS,IBP,PLANDATA,PLANOK
+3 KILL ^TMP($JOB,"IBCNOR","FND")
+4 ; user selected insurance companies
+5 IF 'IBCNOR("IBIG")
Begin DoDot:1
+6 SET IBINSN=""
SET (IBQUIT,IBSTOP,IBCO)=0
+7 FOR
SET IBINSN=$ORDER(IBSORT(IBINSN))
if IBINSN=""
QUIT
Begin DoDot:2
+8 SET IBINS=0
FOR
SET IBINS=$ORDER(IBSORT(IBINSN,IBINS))
if 'IBINS
QUIT
Begin DoDot:3
+9 SET IBC=IBSORT(IBINSN,IBINS)
SET IBCO=IBCO+1
+10 ;clear the plans before build
+11 KILL ^TMP("IBCNOR",$JOB,"INS",IBC,"GRP")
+12 ;
+13 SET IBOK=0
WRITE !!,"Insurance Company # "_IBCO_": "_IBINSN
+14 DO OK^IBCNSM3
+15 IF IBQUIT
SET IBSTOP=1
QUIT
+16 ;I 'IBOK K ^TMP("IBCNOR",$J,"INS",IBC) Q
+17 IF 'IBOK
QUIT
+18 WRITE " ...building a list of plans..."
+19 ; The Groups listed will be filtered the based on the users selections above
+20 KILL ^TMP($JOB,"IBSEL")
+21 DO LKP^IBCNSU21(IBINS,1,1,IBCNOR("IBIGN"),IBCNOR("IBFIL"))
+22 IF IBQUIT
SET IBSTOP=1
QUIT
+23 IF $GET(^TMP($JOB,"IBSEL",0))=0
Begin DoDot:4
+24 KILL ^TMP("IBCNOR",$JOB,"INS",IBC,"GRP")
End DoDot:4
+25 ;
+26 ; Add SELECTED Plans to ^TMP("IBCNOR")
+27 IF $GET(^TMP($JOB,"IBSEL",0))>0
Begin DoDot:4
+28 SET GCT=0
+29 SET GIEN=0
FOR
SET GIEN=$ORDER(^TMP($JOB,"IBSEL",GIEN))
if 'GIEN
QUIT
Begin DoDot:5
+30 SET GCT=GCT+1
+31 SET ^TMP("IBCNOR",$JOB,"INS",IBC,"GRP",GCT)=GIEN
End DoDot:5
End DoDot:4
End DoDot:3
IF IBQUIT!(IBSTOP)
QUIT
End DoDot:2
IF IBQUIT!(IBSTOP)
QUIT
+32 KILL ^TMP($JOB,"IBCNOR","FND")
MERGE ^TMP($JOB,"IBCNOR","FND")=^TMP("IBCNOR",$JOB,"INS")
End DoDot:1
+33 QUIT
+34 ;
BLDINSGR ; go through insurances and get their groups
+1 ;
+2 NEW IBC,IBCT,GCT,GIEN,IBC,IBINS,IBP,PLANDATA,PLANOK
+3 ; user selected ALL insurance companies
+4 SET IBCT=0
+5 IF IBCNOR("IBIG")
Begin DoDot:1
+6 SET (IBC,GCT,IBINS,IBSTOP)=0
+7 FOR
SET IBC=$ORDER(^TMP("IBCNOR",$JOB,"INS",IBC))
if 'IBC
QUIT
SET IBINS=$GET(^TMP("IBCNOR",$JOB,"INS",IBC))
IF IBINS
Begin DoDot:2
+8 SET GCT=0
SET IBP=0
+9 FOR
SET IBP=$ORDER(^IBA(355.3,"B",+IBINS,IBP))
if 'IBP
QUIT
Begin DoDot:3
+10 SET IBCT=IBCT+1
IF $GET(IOST)["C-"&(IBCT#1000=0)
WRITE "."
+11 KILL PLANDATA,PLANOK
+12 DO GETS^DIQ(355.3,+IBP_",",".11;2.01;2.02","EI","PLANDATA")
+13 ; only get active plans
IF $GET(PLANDATA(355.3,IBP,.11,"I"))
QUIT
+14 ;
+15 SET GCT=GCT+1
+16 SET ^TMP("IBCNOR",$JOB,"INS",IBC,"GRP",GCT)=IBP
End DoDot:3
End DoDot:2
if IBSTOP
QUIT
End DoDot:1
+17 QUIT
+18 ;
