- 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 Jan 18, 2025@03:17:16 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 ;