IBJDI4 ;ALB/CPM - PATIENTS WITH UNIDENTIFIED INSURANCE ;17-DEC-96
;;2.0;INTEGRATED BILLING;**69,98,100,118,528,771**;21-MAR-94;Build 26
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; - Option entry point.
;
W !!,"This report provides the number of patients who have been treated,"
W !,"but not identified as having or not having insurance.",!
;
DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
;
; - Sort by division?
S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D HLP1^IBJDI4"
S DIR("A")="Do you wish to sort this report by division" W !
D ^DIR S IBSORT=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
K DIR,DIROUT,DTOUT,DUOUT,DIRUT
;
I IBSORT D PSDR^IBODIV G:Y<0 ENQ ; Select division(s).
;
; - Select a detailed or summary report.
D DS^IBJD G:IBRPT["^" ENQ S IBSEL=0
I IBRPT="S" W !!,"This report only requires an 80 column printer." G FMT
;
SEL W !!,"Print 1-MAIN REPORT or 2-LINE ITEM REPORTS: 1// "
R X:DTIME G:'$T!(X["^") ENQ S:X="" X=1 I "1^2"'[X D HLP2 G SEL
W " ",$S(X=2:"LINE ITEM REPORTS",1:"MAIN REPORT") I X=1 G RMK
;
RPTS ; - Select line item report(s).
W ! S DIR(0)="LO^1:9^K:+$P(X,""-"",2)>9 X"
F X=1:1:9 S DIR("A",X)=X_" - Print "_$$TITLE(X)
S DIR("A",10)="",DIR("A")="Select",DIR("B")=1 D ^DIR K DIR I Y["^" G ENQ
W ! S IBSEL=Y,DIR(0)="YO",DIR("A",1)="You have selected"
I X="1-9" S DIR("A",1)=DIR("A",1)_" ALL the above reports."
E F X=1:1 S X1=$P(IBSEL,",",X) Q:'X1 S DIR("A",X+1)=" "_$$TITLE(X1)
S DIR("A")="Are you sure",DIR("B")="NO" D ^DIR K DIR I Y["^" G ENQ
I 'Y G RPTS
;
RMK ; - Select print/not print remarks.
W ! S DIR(0)="YO"
S DIR("A")="Do you want the patient's remarks to print on the report"
S DIR("B")="NO" D ^DIR K DIR S IBRMK=Y I IBRMK["^" G ENQ
;
FMT ; - Select output format.
K IBOUT
S IBOUT=$$OUT I $G(STOP) G ENQ
;
I IBOUT="R",IBRPT="D" W !!,"You will need a 132 column printer for this report."
; IB*771/DTG excel device message
I IBOUT="E" W !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping of the data saved to the file, please enter '0;256;99999' at the DEVICE: prompt"
;
DEV ; - Select a device.
W !!,"Note: This report may take a while to run."
W !?6,"You should queue this report to run after normal business hours.",!
;
S %ZIS="QM" D ^%ZIS G:POP ENQ
I $D(IO("Q")) D G ENQ
.S ZTRTN="DQ^IBJDI4",ZTDESC="IB - PATIENTS WITH UNIDENTIFIED INSURANCE"
.F I="IB*","IBOUT","VAUTD","VAUTD(" S ZTSAVE(I)=""
.D ^%ZTLOAD
.W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
DQ ; - Tasked entry point.
;
I $G(IBXTRACT) D E^IBJDE(4,1) ; Change extract status.
;
N IBQUERY K IB,^TMP("IBJDI41",$J),^TMP("IBJDI42",$J)
S IBC="BILL^DEC^HMO^IND^MEDC^MEDG^NO^NULL^TOT^UNK^YES",IBQ=0
I IBSORT D G PROC
.S I=0 F S I=$S(VAUTD:$O(^DG(40.8,I)),1:$O(VAUTD(I))) Q:'I D
..S J=$P($G(^DG(40.8,I,0)),U) F K=1:1:11 S IB(J,$P(IBC,U,K))=0
S IBDIV="ALL" F I=1:1:11 S IB("ALL",$P(IBC,U,I))=0
;
PROC D EN^IBJDI41 ; Process and print report(s).
;
ENQ K ^TMP("IBJDI41",$J),^TMP("IBJDI42",$J)
I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
;
D ^%ZISC
ENQ1 K IB,IBQ,IBBDT,IBEDT,IBRMK,IBRPT,IBD,IBDN,IBPH,IBPAG,IBRUN,IBX,IBX1,IBX2
K IBC,IBELIG,IBPER,IBPM,IBPMD,IBDOD,IBFL,IBFL1,IBIPC,IBINSC,IBPAT,IBSEL
K IBDIV,IBSEL1,IBSORT,VAUTD,DFN,POP,I,J,K,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE
K DIR,DIROUT,DTOUT,DUOUT,DIRUT,%,%ZIS,IBOUT,IBXTRACT,STOP
Q
;
HLP1 ; - 'Sort by division' prompt.
W !!,"Select: '<CR>' to print the trend report without regard to"
W !?15,"division"
W !?11,"'Y' to select those divisions for which a separate"
W !?15,"trend report should be created",!?11,"'^' to quit"
Q
;
HLP2 ; - 'Print 1-MAIN REPORT'... prompt.
W !!,"Select: '1' to print the Patients w/Unidentified Insurance Report"
W !?8,"'2' to print up to nine specific reports based on the line items"
W !?12,"of the summary report",!?8,"'^' to quit"
Q
;
TITLE(X) ; - Print report title.
Q $P($T(TITLE1+X),";;",2)
;
TITLE1 ;;Patients with Unidentified Insurance
;;Patients Covered by Insurance
;;Patients Covered by Billable Insurance
;;Patients Covered by an HMO
;;Patients Covered by Medicare
;;Patients Covered by Medigap
;;Patients Covered by an Indemnity Policy
;;Patients Not Covered by Insurance
;;Patients with Unknown Insurance
;;Patients with Insurance Question Unanswered
;
TYPE(INS) ; - Find type of insurance.
; Input: INS=Patient's insurance info in file #2 (.3121)
; Output: Y=1-HMO, 2-Medicare, 3-Medigap, 4-Indemnity, or
; 0-None of the above
;
N TYP
S Y=0,TYP=+$P($G(^IBA(355.3,+$P(INS,U,18),0)),U,9) I 'TYP G TYP1
I $D(^IBE(355.1,"B","HEALTH MAINTENANCE ORGANIZ",TYP)) S Y=1
I $D(^IBE(355.1,"B","POINT OF SERVICE",TYP)) S Y=1
I $D(^IBE(355.1,"B","PREPAID GROUP PRACTICE PLAN",TYP)) S Y=1
I $D(^IBE(355.1,"B","MEDICARE (M)",TYP)) S Y=2
I $D(^IBE(355.1,"B","MEDICARE/MEDICAID (MEDI-CAL)",TYP)) S Y=2
I $D(^IBE(355.1,"B","MEDIGAP (SUPPLEMENTAL)",TYP)) S Y=3
I $D(^IBE(355.1,"B","INCOME PROTECTION (INDEMNITY)",TYP)) S Y=4
;
TYP1 G:Y TYPQ S TYP=+$P($G(^DIC(36,+INS,0)),U,13) I 'TYP G TYPQ
I $D(^IBE(355.2,"B","HEALTH MAINTENANCE ORG.",TYP)) S Y=1
I $D(^IBE(355.2,"B","MEDICARE",TYP)) S Y=2
I $D(^IBE(355.2,"B","MEDIGAP",TYP)) S Y=3
I $D(^IBE(355.2,"B","INDEMNITY",TYP)) S Y=4
;
TYPQ Q Y
;
OUT() ; Prompt to allow users to select output format
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"
D ^DIR I $D(DIRUT) S STOP=1 Q ""
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDI4 5722 printed Oct 16, 2024@18:23:56 Page 2
IBJDI4 ;ALB/CPM - PATIENTS WITH UNIDENTIFIED INSURANCE ;17-DEC-96
+1 ;;2.0;INTEGRATED BILLING;**69,98,100,118,528,771**;21-MAR-94;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; - Option entry point.
+1 ;
+2 WRITE !!,"This report provides the number of patients who have been treated,"
+3 WRITE !,"but not identified as having or not having insurance.",!
+4 ;
DATE DO DATE^IBOUTL
IF IBBDT=""!(IBEDT="")
GOTO ENQ
+1 ;
+2 ; - Sort by division?
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("?")="^D HLP1^IBJDI4"
+4 SET DIR("A")="Do you wish to sort this report by division"
WRITE !
+5 DO ^DIR
SET IBSORT=+Y
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO ENQ
+6 KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT
+7 ;
+8 ; Select division(s).
IF IBSORT
DO PSDR^IBODIV
if Y<0
GOTO ENQ
+9 ;
+10 ; - Select a detailed or summary report.
+11 DO DS^IBJD
if IBRPT["^"
GOTO ENQ
SET IBSEL=0
+12 IF IBRPT="S"
WRITE !!,"This report only requires an 80 column printer."
GOTO FMT
+13 ;
SEL WRITE !!,"Print 1-MAIN REPORT or 2-LINE ITEM REPORTS: 1// "
+1 READ X:DTIME
if '$TEST!(X["^")
GOTO ENQ
if X=""
SET X=1
IF "1^2"'[X
DO HLP2
GOTO SEL
+2 WRITE " ",$SELECT(X=2:"LINE ITEM REPORTS",1:"MAIN REPORT")
IF X=1
GOTO RMK
+3 ;
RPTS ; - Select line item report(s).
+1 WRITE !
SET DIR(0)="LO^1:9^K:+$P(X,""-"",2)>9 X"
+2 FOR X=1:1:9
SET DIR("A",X)=X_" - Print "_$$TITLE(X)
+3 SET DIR("A",10)=""
SET DIR("A")="Select"
SET DIR("B")=1
DO ^DIR
KILL DIR
IF Y["^"
GOTO ENQ
+4 WRITE !
SET IBSEL=Y
SET DIR(0)="YO"
SET DIR("A",1)="You have selected"
+5 IF X="1-9"
SET DIR("A",1)=DIR("A",1)_" ALL the above reports."
+6 IF '$TEST
FOR X=1:1
SET X1=$PIECE(IBSEL,",",X)
if 'X1
QUIT
SET DIR("A",X+1)=" "_$$TITLE(X1)
+7 SET DIR("A")="Are you sure"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y["^"
GOTO ENQ
+8 IF 'Y
GOTO RPTS
+9 ;
RMK ; - Select print/not print remarks.
+1 WRITE !
SET DIR(0)="YO"
+2 SET DIR("A")="Do you want the patient's remarks to print on the report"
+3 SET DIR("B")="NO"
DO ^DIR
KILL DIR
SET IBRMK=Y
IF IBRMK["^"
GOTO ENQ
+4 ;
FMT ; - Select output format.
+1 KILL IBOUT
+2 SET IBOUT=$$OUT
IF $GET(STOP)
GOTO ENQ
+3 ;
+4 IF IBOUT="R"
IF IBRPT="D"
WRITE !!,"You will need a 132 column printer for this report."
+5 ; IB*771/DTG excel device message
+6 IF IBOUT="E"
WRITE !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping of the data saved to the file, please enter '0;256;99999' at the DEVICE: prompt"
+7 ;
DEV ; - Select a device.
+1 WRITE !!,"Note: This report may take a while to run."
+2 WRITE !?6,"You should queue this report to run after normal business hours.",!
+3 ;
+4 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO ENQ
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTRTN="DQ^IBJDI4"
SET ZTDESC="IB - PATIENTS WITH UNIDENTIFIED INSURANCE"
+7 FOR I="IB*","IBOUT","VAUTD","VAUTD("
SET ZTSAVE(I)=""
+8 DO ^%ZTLOAD
+9 WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+10 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+11 ;
+12 USE IO
+13 ;
DQ ; - Tasked entry point.
+1 ;
+2 ; Change extract status.
IF $GET(IBXTRACT)
DO E^IBJDE(4,1)
+3 ;
+4 NEW IBQUERY
KILL IB,^TMP("IBJDI41",$JOB),^TMP("IBJDI42",$JOB)
+5 SET IBC="BILL^DEC^HMO^IND^MEDC^MEDG^NO^NULL^TOT^UNK^YES"
SET IBQ=0
+6 IF IBSORT
Begin DoDot:1
+7 SET I=0
FOR
SET I=$SELECT(VAUTD:$ORDER(^DG(40.8,I)),1:$ORDER(VAUTD(I)))
if 'I
QUIT
Begin DoDot:2
+8 SET J=$PIECE($GET(^DG(40.8,I,0)),U)
FOR K=1:1:11
SET IB(J,$PIECE(IBC,U,K))=0
End DoDot:2
End DoDot:1
GOTO PROC
+9 SET IBDIV="ALL"
FOR I=1:1:11
SET IB("ALL",$PIECE(IBC,U,I))=0
+10 ;
PROC ; Process and print report(s).
DO EN^IBJDI41
+1 ;
ENQ KILL ^TMP("IBJDI41",$JOB),^TMP("IBJDI42",$JOB)
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
GOTO ENQ1
+2 ;
+3 DO ^%ZISC
ENQ1 KILL IB,IBQ,IBBDT,IBEDT,IBRMK,IBRPT,IBD,IBDN,IBPH,IBPAG,IBRUN,IBX,IBX1,IBX2
+1 KILL IBC,IBELIG,IBPER,IBPM,IBPMD,IBDOD,IBFL,IBFL1,IBIPC,IBINSC,IBPAT,IBSEL
+2 KILL IBDIV,IBSEL1,IBSORT,VAUTD,DFN,POP,I,J,K,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE
+3 KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT,%,%ZIS,IBOUT,IBXTRACT,STOP
+4 QUIT
+5 ;
HLP1 ; - 'Sort by division' prompt.
+1 WRITE !!,"Select: '<CR>' to print the trend report without regard to"
+2 WRITE !?15,"division"
+3 WRITE !?11,"'Y' to select those divisions for which a separate"
+4 WRITE !?15,"trend report should be created",!?11,"'^' to quit"
+5 QUIT
+6 ;
HLP2 ; - 'Print 1-MAIN REPORT'... prompt.
+1 WRITE !!,"Select: '1' to print the Patients w/Unidentified Insurance Report"
+2 WRITE !?8,"'2' to print up to nine specific reports based on the line items"
+3 WRITE !?12,"of the summary report",!?8,"'^' to quit"
+4 QUIT
+5 ;
TITLE(X) ; - Print report title.
+1 QUIT $PIECE($TEXT(TITLE1+X),";;",2)
+2 ;
TITLE1 ;;Patients with Unidentified Insurance
+1 ;;Patients Covered by Insurance
+2 ;;Patients Covered by Billable Insurance
+3 ;;Patients Covered by an HMO
+4 ;;Patients Covered by Medicare
+5 ;;Patients Covered by Medigap
+6 ;;Patients Covered by an Indemnity Policy
+7 ;;Patients Not Covered by Insurance
+8 ;;Patients with Unknown Insurance
+9 ;;Patients with Insurance Question Unanswered
+10 ;
TYPE(INS) ; - Find type of insurance.
+1 ; Input: INS=Patient's insurance info in file #2 (.3121)
+2 ; Output: Y=1-HMO, 2-Medicare, 3-Medigap, 4-Indemnity, or
+3 ; 0-None of the above
+4 ;
+5 NEW TYP
+6 SET Y=0
SET TYP=+$PIECE($GET(^IBA(355.3,+$PIECE(INS,U,18),0)),U,9)
IF 'TYP
GOTO TYP1
+7 IF $DATA(^IBE(355.1,"B","HEALTH MAINTENANCE ORGANIZ",TYP))
SET Y=1
+8 IF $DATA(^IBE(355.1,"B","POINT OF SERVICE",TYP))
SET Y=1
+9 IF $DATA(^IBE(355.1,"B","PREPAID GROUP PRACTICE PLAN",TYP))
SET Y=1
+10 IF $DATA(^IBE(355.1,"B","MEDICARE (M)",TYP))
SET Y=2
+11 IF $DATA(^IBE(355.1,"B","MEDICARE/MEDICAID (MEDI-CAL)",TYP))
SET Y=2
+12 IF $DATA(^IBE(355.1,"B","MEDIGAP (SUPPLEMENTAL)",TYP))
SET Y=3
+13 IF $DATA(^IBE(355.1,"B","INCOME PROTECTION (INDEMNITY)",TYP))
SET Y=4
+14 ;
TYP1 if Y
GOTO TYPQ
SET TYP=+$PIECE($GET(^DIC(36,+INS,0)),U,13)
IF 'TYP
GOTO TYPQ
+1 IF $DATA(^IBE(355.2,"B","HEALTH MAINTENANCE ORG.",TYP))
SET Y=1
+2 IF $DATA(^IBE(355.2,"B","MEDICARE",TYP))
SET Y=2
+3 IF $DATA(^IBE(355.2,"B","MEDIGAP",TYP))
SET Y=3
+4 IF $DATA(^IBE(355.2,"B","INDEMNITY",TYP))
SET Y=4
+5 ;
TYPQ QUIT Y
+1 ;
OUT() ; Prompt to allow users to select output format
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
QUIT ""
+7 QUIT Y
