Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBJDI4

IBJDI4.m

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