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

IBCNERPJ.m

Go to the documentation of this file. 
  1. IBCNERPJ ;IB/BAA/AWC - IBCNE EIV HL7 RESPONSE REPORT;25 Feb 2015
  1.  ;;2.0;INTEGRATED BILLING;**528,668,737,763**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Variables:
  1.  ; IB*763/TAZ - Change IBCNERTN comment to reference proper routine.
  1.  ;   IBCNERTN = "IBCNERPJ" (current routine name for queueing the 
  1.  ;                          COMPILE process)
  1.  ;   INCNESPJ("BEGDT") = start date for date range
  1.  ;   INCNESPJ("ENDDT") = end date for date range
  1.  ;   INCNESPJ("PYR",ien) = payer iens for report, if INCNESPJ("PYR")="A", then include all
  1.  ;   IBCNESPJ("PAT",ien) = patient iens for report, if IBCNESPJ("PAT")="A", then include all
  1.  ;   INCNESPJ("TYPE") = report type: "R" - Report, "E" - Excel
  1.  ;
  1.  Q
  1. EN ; entry point
  1.  N STOP,IBCNERTN,INCNESPJ,I,IBCNESPJ
  1.  ;
  1.  I $G(DT)="" S DT=$$DT^XLFDT  ; IB*737/DTG make sure system date is there
  1.  ;
  1.  S STOP=0,IBCNERTN="IBCNERPJ"
  1.  K ^TMP($J,IBCNERTN)
  1.  W @IOF
  1.  W !,"eIV HL7 Response Report",!
  1.  ; Prompts for HL7 Response Report
  1.  ; Report Type - Report or Excel
  1. P10 D TYPE I STOP G EXIT
  1.  ; Payer Selection parameter
  1. P20 D PAYER I STOP G:$$STOP^IBCNERP1 EXIT G P10
  1.  ; Date Range parameters
  1. P30 D DTRANGE I STOP G:$$STOP^IBCNERP1 EXIT G P20
  1.  ; Patient Selection parameter
  1. P40 D PATIENT I STOP G:$$STOP^IBCNERP1 EXIT G P30
  1.  ; Select the output device
  1. P100 D DEVICE
  1.  ;
  1. EXIT ;
  1.  Q
  1.  ;
  1. PAYER ;
  1.  ;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
  1.  N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR("A")="Run for (A)ll Payers or (S)elected Payers: "
  1.  S DIR("A",1)="PAYER SELECTION:"
  1.  S DIR(0)="SA^A:All;S:Selected",DIR("B")="A"
  1.  D ^DIR
  1.  I $D(DIRUT) S STOP=1 Q
  1.  I Y="A" S INCNESPJ("PYR")="A" Q  ; "All Payers" selected
  1.  S DIC(0)="ABEQ"
  1.  S DIC("A")="Select Payer(s): "
  1.  ; Do not allow selection of non-eIV payers
  1.  ;IB*668/TAZ - Changed Payer Application from IIV to EIV
  1.  S DIC("S")="I $$PYRAPP^IBCNEUT5(""EIV"",$G(Y))'="""""
  1.  S DIC="^IBE(365.12,"
  1. PAYER1 ;
  1.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT)!(Y=-1) S STOP=1 K INCNESPJ("PYR") Q
  1.  S INCNESPJ("PYR",$P(Y,U,1))=""
  1.  I $$ANOTHER G PAYER1
  1.  Q
  1.  ;
  1. PATIENT ;
  1.  N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  ; summary report is always run for all patients
  1.  W !
  1.  S DIR("A")="Run for (A)ll Patients or (S)elected Patients: "
  1.  S DIR("A",1)="PATIENT SELECTION:"
  1.  S DIR(0)="SA^A:All;S:Selected",DIR("B")="A"
  1.  D ^DIR
  1.  I $D(DIRUT) S STOP=1 Q
  1.  I Y="A" S INCNESPJ("PAT")="A" Q  ; "All Patients" selected
  1.  S DIC(0)="ABEQ"
  1.  S DIC("A")="Select Patient: "
  1.  S DIC="^DPT("
  1. PATIENT1 ;
  1.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT)!(Y=-1) S STOP=1 K IBCNESPC("PAT") Q
  1.  S INCNESPJ("PAT",$P(Y,U,1))=""
  1.  I $$ANOTHER G PATIENT1
  1.  Q
  1.  ;
  1. DTRANGE ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  ;S DIR(0)="D^::EX",DIR("B")="Today"
  1.  S DIR(0)="D^:DT:EX",DIR("B")="Today"  ; IB*737/DTG max is current Date
  1.  S DIR("A")="Earliest Date Received"
  1.  S DIR("A",1)="RESPONSE RECEIVED DATE RANGE SELECTION:"
  1.  D ^DIR I $D(DIRUT) S STOP=1 Q
  1.  S INCNESPJ("BEGDT")=Y
  1.  ; End date
  1. DTRANGE1 ;
  1.  K DIR("A") S DIR("A")="  Latest Date Received"
  1.  D ^DIR I $D(DIRUT) S STOP=1 Q
  1.  I Y<INCNESPJ("BEGDT") W !,"     Latest Date must not precede the Earliest Date." G DTRANGE1
  1.  S INCNESPJ("ENDDT")=Y
  1.  Q
  1.  ;
  1. ANOTHER() ; "Select Another" prompt
  1.  ; returns 1, if response was "YES", returns 0 otherwise
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR("A")="Select Another?" S DIR(0)="Y",DIR("B")="NO"
  1.  D ^DIR I $D(DIRUT) S STOP=1
  1.  Q Y
  1.  ;
  1. TYPE ;
  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")="Excel"
  1.  D ^DIR I $D(DIRUT) S STOP=1 Q
  1.  S INCNESPJ("TYPE")=Y
  1.  Q
  1.  ;
  1. DEVICE ; Ask user to select device
  1.  N %ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ,POP
  1.  ;
  1.  ; IB*737/DTG changes to device sequence and correct queueing in this tag
  1.  N IBTYPE,IBCHK S IBTYPE=$E(INCNESPJ("TYPE"),1),IBCHK=$S(IBTYPE="R":132,1:256)
  1.  I IBTYPE="E" D
  1.  . W !!,"For CSV output, turn logging or capture on now."
  1.  . W !,"To avoid undesired wrapping of the data saved to the file,"
  1.  . W !,"please enter ""0;256;99999"" at the ""DEVICE:"" prompt.",!
  1.  ;W !!,"*** You will need a 132 column printer for this report. ***",!
  1.  I IBTYPE="R" W !!,"*** You will need a 132 column printer for this report. ***",!
  1.  ;
  1.  ;S %ZIS="QM" D ^%ZIS G:POP ENQ
  1.  S INCNESPJ("WIDTH")=$S((+$G(IOM)>0&($G(IOM)<(IBCHK+1))):IOM,1:IBCHK)
  1.  ;I $D(IO("Q")) D  G ENQ
  1.  ;.S ZTRTN="EN^IBCNGPF3",ZTDESC="IB - Interfacility Ins Update Activity Report"
  1.  ;.F I="^TMP($J,""PR"",","IBABY","IBOUT" S ZTSAVE(I)=""
  1.  ;.D ^%ZTLOAD K IO("Q") D HOME^%ZIS
  1.  ;.W !!,$S($D(ZTSK):"This job has been queued as task #"_ZTSK_".",1:"Unable to queue this job.")
  1.  ;.K ZTSK,IO("Q")
  1.  ;
  1.  ; Compile and print report
  1.  ;
  1.  ;U IO D EN^IBCNERPK(IBCNERTN,.INCNESPJ)
  1.  ;
  1.  ;D ^%ZISC
  1.  ; 
  1.  ;I $D(ZTQUEUED) S ZTREQ="@"
  1.  S INCNESPJ("WIDTH")=IBCHK
  1.  S ZTRTN="EN^IBCNERPK(IBCNERTN,.INCNESPJ)",ZTDESC="IB - HL7 Response Report"
  1.  F I="IBCNERTN","INCNESPJ","INCNESPJ(" S ZTSAVE(I)=""
  1.  F I="IBTYPE","IBOUT","^TMP($J,IBCNERTN," S ZTSAVE(I)=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q")
  1.  ;
  1. ENQ ;
  1.  ;K STOP,INCNESPJ,^TMP($J,IBCNERTN),IBCNERTN
  1.  I POP K STOP,^TMP($J,IBCNERTN),IBCNERTN,INCNESPJ
  1.  Q