- 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 Feb 18, 2025@23:49:41 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