- IBCMDT ;ALB/VD - INSURANCE PLANS MISSING DATA REPORT (DRIVER) ; 10-APR-15
- ;;2.0;INTEGRATED BILLING ;**549,763**; 10-APR-15;Build 29
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; IB - Insurance Plans Missing Data Report.
- ;
- ;Input parameters: N/A
- ;
- ;Other relevant variables:
- ; ZTSAVED for queuing
- ;
- ; IBMDTSPC("FLTRS") n where n is the number of filters selected
- ; IBMDTSPC("IBAI") 0 = user selected insurance companies.
- ; 1 = all insurance companies w/plans.
- ;
- ; IBMDTSPC("IBAPL") 0 = user selected plans (may be ALL for certain companies, some for other companies).
- ; 1 = all plans for the insurance companies (all or selected).
- ;
- ; IBMDTSPC("IBGRN") 0 = ignore Missing Group Number filter.
- ; 1 = include Missing Group Number filter.
- ;
- ; IBMDTSPC("IBPTY") 0 = ignore Missing Type of Plan filter.
- ; 1 = include Missing Type of Plan filter.
- ;
- ; IBMDTSPC("IBTFT") 0 = ignore Missing Timely Filing Time Frame filter.
- ; 1 = include Missing Timely Filing Time Frame filter.
- ;
- ; IBMDTSPC("IBEPT") 0 = ignore Missing Electronic Plan Type filter.
- ; 1 = include Missing Electronic Plan Type filter.
- ;
- ; IBMDTSPC("IBCLM") 0 = ignore Missing Coverage Limitation filter.
- ; 1 = include Missing Coverage Limitation filter.
- ;
- ; IBMDTSPC("IBBIN") 0 = ignore Missing BIN (Banking Identification Number) filter.
- ; 1 = include Missing BIN (Banking Identification Number) filter.
- ;
- ; IBMDTSPC("IBPCN") 0 = ignore Missing PCN (Processor Control Number) filter.
- ; 1 = include Missing PCN (Processor Control Number) filter.
- ; IBMDTSPC("IBNMSPC") = $J of the parent job (if queued)
- ;
- EN ; Main Entry point.
- ; Initialize variables.
- N IBAI,IBMDTSPC,POP,STOP
- ;
- C0 ; Start the Insurance Company Prompts.
- K IBMDTSPC,^TMP("IBCMDT",$J),^TMP($J,"IBSEL")
- S STOP=0,IBMDTSPC("IBNMSPC")=$J
- ;
- W @IOF
- ;IB*763/CKB - the intro sentence should reference group plans not insurance companies
- W !!?5,"This report will generate a list of ACTIVE group plans"
- W !?5,"that are missing the data that you select to be reported upon.",!!
- ;
- ; Select Insurance Companies or All Insurance Companies w/Plans
- C10 D SLAI^IBCMDT1 I STOP G:$$STOP EXIT G C0
- N IBQUIT S IBQUIT=0
- S IBAI=+$G(IBMDTSPC("IBAI"))
- D START
- I IBQUIT G EXIT
- I '$D(^TMP("IBCMDT",$J)) W !!,"No plans selected!" G EXIT
- ;
- FILTERS ; Begin the Filtering Questions.
- ;
- N STOP
- F0 ; Start of Filters.
- S (IBMDTSPC("FLTRS"),STOP)=0
- S IBMDTSPC("SUBHD")="Missing Data: "
- ; Filter on Missing Group Number
- F10 D SLGRN^IBCMDT1
- I STOP G:$$STOP EXIT G C0
- I +IBMDTSPC("IBGRN") D
- . S IBMDTSPC("SUBHD")=IBMDTSPC("SUBHD")_"Group #"
- . S IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- ;
- ; Filter on Missing Type of Plan
- F20 D SLPTY^IBCMDT1
- I STOP G:$$STOP EXIT G F10
- I +IBMDTSPC("IBPTY") D
- . S IBMDTSPC("SUBHD")=$G(IBMDTSPC("SUBHD"))_$S(+IBMDTSPC("FLTRS"):", ",1:"")_"Plan Type"
- . S IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- ;
- ; Filter on Missing Timely Filing Time Frame
- F30 D SLTFT^IBCMDT1
- I STOP G:$$STOP EXIT G F20
- I +IBMDTSPC("IBTFT") D
- . S IBMDTSPC("SUBHD")=$G(IBMDTSPC("SUBHD"))_$S(+IBMDTSPC("FLTRS"):", ",1:"")_"FTF"
- . S IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- ;
- ; Filter on Missing Electronic Plan Type
- F40 D SLEPT^IBCMDT1
- I STOP G:$$STOP EXIT G F30
- I +IBMDTSPC("IBEPT") D
- . S IBMDTSPC("SUBHD")=$G(IBMDTSPC("SUBHD"))_$S(+IBMDTSPC("FLTRS"):", ",1:"")_"Elec Plan"
- . S IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- ;
- ; Filter on Missing Coverage Limitations
- F50 D SLCLM^IBCMDT1
- I STOP G:$$STOP EXIT G F40
- I +IBMDTSPC("IBCLM") S IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- ;
- ; Filter on Missing BIN (Banking Identification Number)
- F60 D SLBIN^IBCMDT1
- I STOP G:$$STOP EXIT G F50
- I +IBMDTSPC("IBBIN") D
- . S IBMDTSPC("SUBHD")=$G(IBMDTSPC("SUBHD"))_$S(+IBMDTSPC("FLTRS"):", ",1:"")_"BIN"
- . S IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- ;
- ; Filter on Missing PCN (Processor Control Number)
- F70 D SLPCN^IBCMDT1
- I STOP G:$$STOP EXIT G F60
- I +IBMDTSPC("IBPCN") D
- . S IBMDTSPC("SUBHD")=$G(IBMDTSPC("SUBHD"))_$S(+IBMDTSPC("FLTRS"):", ",1:"")_"PCN"
- . S IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- ;
- I '+IBMDTSPC("FLTRS") D G:$D(DUOUT) EXIT G FILTERS
- . W !!,"** No Filters were selected **" ; No Filters were selected so quit.
- . D PAUSE^VALM1
- I +IBMDTSPC("IBCLM") D
- . S IBMDTSPC("SUBHD")=$G(IBMDTSPC("SUBHD"))_$S((+IBMDTSPC("FLTRS")>1):", ",1:"")
- . S IBMDTSPC("SUBHD")=IBMDTSPC("SUBHD")_"Coverage Limitations"
- ;
- F100 D DEVICE(.IBMDTSPC)
- I STOP G EXIT ;IB*763/CKB - exit the report if user enters '^'
- ;
- EXIT ; Exit point
- Q
- ;
- STOP() ; Determine if user wants to exit out of the whole option
- ; Initialize Variables
- N DIR,DIRUT,X,Y
- ;
- 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 (STOP,Y)=1 G STOPX
- I 'Y S STOP=0
- STOPX ; STOP Exit Point
- Q Y
- ;
- START ; Gather the Insurance Companies and respective Plans
- I 'IBAI D GTSEL,GTPLNS G STARTQ
- D GTALL,GTPLNS
- G STARTQ
- ;
- GTSEL ; Gather plans for all selected companies.
- N IBCNS,IBIC
- S (IBCT,IBQUIT)=0
- K ^TMP("IBCMDT",$J),^TMP($J,"IBSEL")
- ;
- ; Allow user selection of Insurance Companies, if required
- D EN^IBCNILK(1) ; Only want Active Insurance Companies
- I '$D(^TMP("IBCNILKA",$J)) S IBQUIT=1 Q ; No Insurance Companies selected
- S IBCNS=""
- F S IBCNS=$O(^TMP("IBCNILKA",$J,IBCNS)) Q:IBCNS="" D
- . ; Insurance Company Name
- . S IBIC=$E($$GET1^DIQ(36,IBCNS_",",.01),1,25)
- . S ^TMP("IBCMDT",$J,IBIC,IBCNS)=""
- K ^TMP("IBCNILKA",$J)
- Q
- ;
- GTALL ; - gather all companies if required
- N IBCNS,IBIC1
- K ^TMP("IBCMDT",$J),^TMP($J,"IBSEL")
- S IBIC1=""
- F S IBIC1=$O(^DIC(36,"B",IBIC1)) Q:IBIC1="" D
- . S IBCNS=0
- . F S IBCNS=$O(^DIC(36,"B",IBIC1,IBCNS)) Q:'IBCNS D
- . . I +$$GET1^DIQ(36,IBCNS_",",.05,"I") Q ; Inactive
- . . S ^TMP("IBCMDT",$J,$E(IBIC1,1,25),IBCNS)=""
- Q
- ;
- GTPLNS ; - gather plans for selected companies
- N IBCNS,IBIC,IBP
- S IBIC=""
- F S IBIC=$O(^TMP("IBCMDT",$J,IBIC)) Q:IBIC=""!IBQUIT D
- . S IBCNS=""
- . F S IBCNS=$O(^TMP("IBCMDT",$J,IBIC,IBCNS)) Q:IBCNS=""!(IBQUIT) D
- . . S IBP=0
- . . F S IBP=$O(^IBA(355.3,"B",+IBCNS,IBP)) Q:'IBP D
- . . . S ^TMP("IBCMDT",$J,IBIC,IBCNS,IBP)="" ; Set plans into the array.
- Q
- ;
- STARTQ ;
- K IBCNS,IBIC,IBCT,IBP,IBSEL,^TMP($J,"IBSEL")
- Q
- ;
- DEVICE(IBMDTSPC) ; Device Handler and possible TaskManager calls
- ; Input: IBMDTSPC - Array passed by reference of the report parameters
- ; See top of routine for a detailed explanation
- ;
- N I,POP,ZTDESC,ZTRTN,ZTSAVE
- W *7,!!!?14,"*** WARNING ***"
- W !?2,"This report may take a little while to compile!"
- W !!?2,"This report is 132 characters wide."
- W !?2,"Please choose an appropriate device.",!
- S ZTRTN="COMPILE^IBCMDT(.IBMDTSPC)"
- S ZTDESC="IB - INSURANCE PLANS MISSING DATA REPORT"
- S ZTSAVE("IBMDTSPC(")=""
- S ZTSAVE("^TMP(""IBCMDT"",$J,")=""
- D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
- I POP S STOP=1
- DEVICEX ; DEVICE Exit Point
- Q
- ;
- COMPILE(IBMDTSPC) ;
- ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
- ; Input: IBMDTSPC - Array passed by reference of the report parameters
- ; See top of routine for a detailed explanation
- ;
- N FLTRS,IBAI,IBAPL,IBBIN,IBCLM,IBEPT,IBGRN,IBNMSPC,IBPCN,IBPTY,IBTFT,SUBHD
- S FLTRS=$G(IBMDTSPC("FLTRS"))
- S IBAI=$G(IBMDTSPC("IBAI"))
- S IBAPL=$G(IBMDTSPC("IBAPL"))
- S IBGRN=$G(IBMDTSPC("IBGRN"))
- S IBPTY=$G(IBMDTSPC("IBPTY"))
- S IBTFT=$G(IBMDTSPC("IBTFT"))
- S IBEPT=$G(IBMDTSPC("IBEPT"))
- S IBCLM=$G(IBMDTSPC("IBCLM"))
- S IBBIN=$G(IBMDTSPC("IBBIN"))
- S IBNMSPC=$G(IBMDTSPC("IBNMSPC"))
- S IBPCN=$G(IBMDTSPC("IBPCN"))
- S SUBHD=$G(IBMDTSPC("SUBHD"))
- ;
- ; Compile
- D EN^IBCMDT2
- ; Print
- D EN^IBCMDT3
- ;
- COMPILX ; COMPILE Exit Point
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCMDT 8191 printed Feb 18, 2025@23:39:58 Page 2
- IBCMDT ;ALB/VD - INSURANCE PLANS MISSING DATA REPORT (DRIVER) ; 10-APR-15
- +1 ;;2.0;INTEGRATED BILLING ;**549,763**; 10-APR-15;Build 29
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; IB - Insurance Plans Missing Data Report.
- +5 ;
- +6 ;Input parameters: N/A
- +7 ;
- +8 ;Other relevant variables:
- +9 ; ZTSAVED for queuing
- +10 ;
- +11 ; IBMDTSPC("FLTRS") n where n is the number of filters selected
- +12 ; IBMDTSPC("IBAI") 0 = user selected insurance companies.
- +13 ; 1 = all insurance companies w/plans.
- +14 ;
- +15 ; IBMDTSPC("IBAPL") 0 = user selected plans (may be ALL for certain companies, some for other companies).
- +16 ; 1 = all plans for the insurance companies (all or selected).
- +17 ;
- +18 ; IBMDTSPC("IBGRN") 0 = ignore Missing Group Number filter.
- +19 ; 1 = include Missing Group Number filter.
- +20 ;
- +21 ; IBMDTSPC("IBPTY") 0 = ignore Missing Type of Plan filter.
- +22 ; 1 = include Missing Type of Plan filter.
- +23 ;
- +24 ; IBMDTSPC("IBTFT") 0 = ignore Missing Timely Filing Time Frame filter.
- +25 ; 1 = include Missing Timely Filing Time Frame filter.
- +26 ;
- +27 ; IBMDTSPC("IBEPT") 0 = ignore Missing Electronic Plan Type filter.
- +28 ; 1 = include Missing Electronic Plan Type filter.
- +29 ;
- +30 ; IBMDTSPC("IBCLM") 0 = ignore Missing Coverage Limitation filter.
- +31 ; 1 = include Missing Coverage Limitation filter.
- +32 ;
- +33 ; IBMDTSPC("IBBIN") 0 = ignore Missing BIN (Banking Identification Number) filter.
- +34 ; 1 = include Missing BIN (Banking Identification Number) filter.
- +35 ;
- +36 ; IBMDTSPC("IBPCN") 0 = ignore Missing PCN (Processor Control Number) filter.
- +37 ; 1 = include Missing PCN (Processor Control Number) filter.
- +38 ; IBMDTSPC("IBNMSPC") = $J of the parent job (if queued)
- +39 ;
- EN ; Main Entry point.
- +1 ; Initialize variables.
- +2 NEW IBAI,IBMDTSPC,POP,STOP
- +3 ;
- C0 ; Start the Insurance Company Prompts.
- +1 KILL IBMDTSPC,^TMP("IBCMDT",$JOB),^TMP($JOB,"IBSEL")
- +2 SET STOP=0
- SET IBMDTSPC("IBNMSPC")=$JOB
- +3 ;
- +4 WRITE @IOF
- +5 ;IB*763/CKB - the intro sentence should reference group plans not insurance companies
- +6 WRITE !!?5,"This report will generate a list of ACTIVE group plans"
- +7 WRITE !?5,"that are missing the data that you select to be reported upon.",!!
- +8 ;
- +9 ; Select Insurance Companies or All Insurance Companies w/Plans
- C10 DO SLAI^IBCMDT1
- IF STOP
- if $$STOP
- GOTO EXIT
- GOTO C0
- +1 NEW IBQUIT
- SET IBQUIT=0
- +2 SET IBAI=+$GET(IBMDTSPC("IBAI"))
- +3 DO START
- +4 IF IBQUIT
- GOTO EXIT
- +5 IF '$DATA(^TMP("IBCMDT",$JOB))
- WRITE !!,"No plans selected!"
- GOTO EXIT
- +6 ;
- FILTERS ; Begin the Filtering Questions.
- +1 ;
- +2 NEW STOP
- F0 ; Start of Filters.
- +1 SET (IBMDTSPC("FLTRS"),STOP)=0
- +2 SET IBMDTSPC("SUBHD")="Missing Data: "
- +3 ; Filter on Missing Group Number
- F10 DO SLGRN^IBCMDT1
- +1 IF STOP
- if $$STOP
- GOTO EXIT
- GOTO C0
- +2 IF +IBMDTSPC("IBGRN")
- Begin DoDot:1
- +3 SET IBMDTSPC("SUBHD")=IBMDTSPC("SUBHD")_"Group #"
- +4 SET IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- End DoDot:1
- +5 ;
- +6 ; Filter on Missing Type of Plan
- F20 DO SLPTY^IBCMDT1
- +1 IF STOP
- if $$STOP
- GOTO EXIT
- GOTO F10
- +2 IF +IBMDTSPC("IBPTY")
- Begin DoDot:1
- +3 SET IBMDTSPC("SUBHD")=$GET(IBMDTSPC("SUBHD"))_$SELECT(+IBMDTSPC("FLTRS"):", ",1:"")_"Plan Type"
- +4 SET IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- End DoDot:1
- +5 ;
- +6 ; Filter on Missing Timely Filing Time Frame
- F30 DO SLTFT^IBCMDT1
- +1 IF STOP
- if $$STOP
- GOTO EXIT
- GOTO F20
- +2 IF +IBMDTSPC("IBTFT")
- Begin DoDot:1
- +3 SET IBMDTSPC("SUBHD")=$GET(IBMDTSPC("SUBHD"))_$SELECT(+IBMDTSPC("FLTRS"):", ",1:"")_"FTF"
- +4 SET IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- End DoDot:1
- +5 ;
- +6 ; Filter on Missing Electronic Plan Type
- F40 DO SLEPT^IBCMDT1
- +1 IF STOP
- if $$STOP
- GOTO EXIT
- GOTO F30
- +2 IF +IBMDTSPC("IBEPT")
- Begin DoDot:1
- +3 SET IBMDTSPC("SUBHD")=$GET(IBMDTSPC("SUBHD"))_$SELECT(+IBMDTSPC("FLTRS"):", ",1:"")_"Elec Plan"
- +4 SET IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- End DoDot:1
- +5 ;
- +6 ; Filter on Missing Coverage Limitations
- F50 DO SLCLM^IBCMDT1
- +1 IF STOP
- if $$STOP
- GOTO EXIT
- GOTO F40
- +2 IF +IBMDTSPC("IBCLM")
- SET IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- +3 ;
- +4 ; Filter on Missing BIN (Banking Identification Number)
- F60 DO SLBIN^IBCMDT1
- +1 IF STOP
- if $$STOP
- GOTO EXIT
- GOTO F50
- +2 IF +IBMDTSPC("IBBIN")
- Begin DoDot:1
- +3 SET IBMDTSPC("SUBHD")=$GET(IBMDTSPC("SUBHD"))_$SELECT(+IBMDTSPC("FLTRS"):", ",1:"")_"BIN"
- +4 SET IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- End DoDot:1
- +5 ;
- +6 ; Filter on Missing PCN (Processor Control Number)
- F70 DO SLPCN^IBCMDT1
- +1 IF STOP
- if $$STOP
- GOTO EXIT
- GOTO F60
- +2 IF +IBMDTSPC("IBPCN")
- Begin DoDot:1
- +3 SET IBMDTSPC("SUBHD")=$GET(IBMDTSPC("SUBHD"))_$SELECT(+IBMDTSPC("FLTRS"):", ",1:"")_"PCN"
- +4 SET IBMDTSPC("FLTRS")=IBMDTSPC("FLTRS")+1
- End DoDot:1
- +5 ;
- +6 IF '+IBMDTSPC("FLTRS")
- Begin DoDot:1
- +7 ; No Filters were selected so quit.
- WRITE !!,"** No Filters were selected **"
- +8 DO PAUSE^VALM1
- End DoDot:1
- if $DATA(DUOUT)
- GOTO EXIT
- GOTO FILTERS
- +9 IF +IBMDTSPC("IBCLM")
- Begin DoDot:1
- +10 SET IBMDTSPC("SUBHD")=$GET(IBMDTSPC("SUBHD"))_$SELECT((+IBMDTSPC("FLTRS")>1):", ",1:"")
- +11 SET IBMDTSPC("SUBHD")=IBMDTSPC("SUBHD")_"Coverage Limitations"
- End DoDot:1
- +12 ;
- F100 DO DEVICE(.IBMDTSPC)
- +1 ;IB*763/CKB - exit the report if user enters '^'
- IF STOP
- GOTO EXIT
- +2 ;
- EXIT ; Exit point
- +1 QUIT
- +2 ;
- STOP() ; Determine if user wants to exit out of the whole option
- +1 ; Initialize Variables
- +2 NEW DIR,DIRUT,X,Y
- +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 (STOP,Y)=1
- GOTO STOPX
- +12 IF 'Y
- SET STOP=0
- STOPX ; STOP Exit Point
- +1 QUIT Y
- +2 ;
- START ; Gather the Insurance Companies and respective Plans
- +1 IF 'IBAI
- DO GTSEL
- DO GTPLNS
- GOTO STARTQ
- +2 DO GTALL
- DO GTPLNS
- +3 GOTO STARTQ
- +4 ;
- GTSEL ; Gather plans for all selected companies.
- +1 NEW IBCNS,IBIC
- +2 SET (IBCT,IBQUIT)=0
- +3 KILL ^TMP("IBCMDT",$JOB),^TMP($JOB,"IBSEL")
- +4 ;
- +5 ; Allow user selection of Insurance Companies, if required
- +6 ; Only want Active Insurance Companies
- DO EN^IBCNILK(1)
- +7 ; No Insurance Companies selected
- IF '$DATA(^TMP("IBCNILKA",$JOB))
- SET IBQUIT=1
- QUIT
- +8 SET IBCNS=""
- +9 FOR
- SET IBCNS=$ORDER(^TMP("IBCNILKA",$JOB,IBCNS))
- if IBCNS=""
- QUIT
- Begin DoDot:1
- +10 ; Insurance Company Name
- +11 SET IBIC=$EXTRACT($$GET1^DIQ(36,IBCNS_",",.01),1,25)
- +12 SET ^TMP("IBCMDT",$JOB,IBIC,IBCNS)=""
- End DoDot:1
- +13 KILL ^TMP("IBCNILKA",$JOB)
- +14 QUIT
- +15 ;
- GTALL ; - gather all companies if required
- +1 NEW IBCNS,IBIC1
- +2 KILL ^TMP("IBCMDT",$JOB),^TMP($JOB,"IBSEL")
- +3 SET IBIC1=""
- +4 FOR
- SET IBIC1=$ORDER(^DIC(36,"B",IBIC1))
- if IBIC1=""
- QUIT
- Begin DoDot:1
- +5 SET IBCNS=0
- +6 FOR
- SET IBCNS=$ORDER(^DIC(36,"B",IBIC1,IBCNS))
- if 'IBCNS
- QUIT
- Begin DoDot:2
- +7 ; Inactive
- IF +$$GET1^DIQ(36,IBCNS_",",.05,"I")
- QUIT
- +8 SET ^TMP("IBCMDT",$JOB,$EXTRACT(IBIC1,1,25),IBCNS)=""
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- GTPLNS ; - gather plans for selected companies
- +1 NEW IBCNS,IBIC,IBP
- +2 SET IBIC=""
- +3 FOR
- SET IBIC=$ORDER(^TMP("IBCMDT",$JOB,IBIC))
- if IBIC=""!IBQUIT
- QUIT
- Begin DoDot:1
- +4 SET IBCNS=""
- +5 FOR
- SET IBCNS=$ORDER(^TMP("IBCMDT",$JOB,IBIC,IBCNS))
- if IBCNS=""!(IBQUIT)
- QUIT
- Begin DoDot:2
- +6 SET IBP=0
- +7 FOR
- SET IBP=$ORDER(^IBA(355.3,"B",+IBCNS,IBP))
- if 'IBP
- QUIT
- Begin DoDot:3
- +8 ; Set plans into the array.
- SET ^TMP("IBCMDT",$JOB,IBIC,IBCNS,IBP)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- STARTQ ;
- +1 KILL IBCNS,IBIC,IBCT,IBP,IBSEL,^TMP($JOB,"IBSEL")
- +2 QUIT
- +3 ;
- DEVICE(IBMDTSPC) ; Device Handler and possible TaskManager calls
- +1 ; Input: IBMDTSPC - Array passed by reference of the report parameters
- +2 ; See top of routine for a detailed explanation
- +3 ;
- +4 NEW I,POP,ZTDESC,ZTRTN,ZTSAVE
- +5 WRITE *7,!!!?14,"*** WARNING ***"
- +6 WRITE !?2,"This report may take a little while to compile!"
- +7 WRITE !!?2,"This report is 132 characters wide."
- +8 WRITE !?2,"Please choose an appropriate device.",!
- +9 SET ZTRTN="COMPILE^IBCMDT(.IBMDTSPC)"
- +10 SET ZTDESC="IB - INSURANCE PLANS MISSING DATA REPORT"
- +11 SET ZTSAVE("IBMDTSPC(")=""
- +12 SET ZTSAVE("^TMP(""IBCMDT"",$J,")=""
- +13 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
- +14 IF POP
- SET STOP=1
- DEVICEX ; DEVICE Exit Point
- +1 QUIT
- +2 ;
- COMPILE(IBMDTSPC) ;
- +1 ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
- +2 ; Input: IBMDTSPC - Array passed by reference of the report parameters
- +3 ; See top of routine for a detailed explanation
- +4 ;
- +5 NEW FLTRS,IBAI,IBAPL,IBBIN,IBCLM,IBEPT,IBGRN,IBNMSPC,IBPCN,IBPTY,IBTFT,SUBHD
- +6 SET FLTRS=$GET(IBMDTSPC("FLTRS"))
- +7 SET IBAI=$GET(IBMDTSPC("IBAI"))
- +8 SET IBAPL=$GET(IBMDTSPC("IBAPL"))
- +9 SET IBGRN=$GET(IBMDTSPC("IBGRN"))
- +10 SET IBPTY=$GET(IBMDTSPC("IBPTY"))
- +11 SET IBTFT=$GET(IBMDTSPC("IBTFT"))
- +12 SET IBEPT=$GET(IBMDTSPC("IBEPT"))
- +13 SET IBCLM=$GET(IBMDTSPC("IBCLM"))
- +14 SET IBBIN=$GET(IBMDTSPC("IBBIN"))
- +15 SET IBNMSPC=$GET(IBMDTSPC("IBNMSPC"))
- +16 SET IBPCN=$GET(IBMDTSPC("IBPCN"))
- +17 SET SUBHD=$GET(IBMDTSPC("SUBHD"))
- +18 ;
- +19 ; Compile
- +20 DO EN^IBCMDT2
- +21 ; Print
- +22 DO EN^IBCMDT3
- +23 ;
- COMPILX ; COMPILE Exit Point
- +1 QUIT