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

IBCNERP1.m

Go to the documentation of this file. 
  1. IBCNERP1 ;DAOU/BHS - IBCNE USER IF eIV RESPONSE REPORT ; 03-JUN-2002
  1.  ;;2.0;INTEGRATED BILLING;**184,271,416,528,549,668,702,737,752,763**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; eIV - Insurance Verification Interface
  1.  ;
  1.  ; IB*737/TAZ - Remove references to ~NO PAYER
  1.  ; IB*763/TAZ - Remove references to routines IBCNERPF, IBCNERPG, and IBCNERPH.
  1.  ;
  1.  ; Input parameters: N/A
  1.  ; Other relevant variables ZTSAVED for queueing:
  1.  ;  IBCNERTN = "IBCNERP1" (current routine name for queueing the 
  1.  ;   COMPILE process)
  1.  ;  IBCNESPC("BEGDT")=start dt for rpt
  1.  ;  IBCNESPC("ENDDT")=end dt for rpt
  1.  ;  IBCNESPC("PYR")=payer ien (365.12) or "" for all payers
  1.  ;  IBCNESPC("SORT")=1 (Payer name) OR 2 (Patient name)
  1.  ;  IBCNESPC("PAT")=patient ien (2) or "" for all patients
  1.  ;  IBCNESPC("TYPE")=A (All Responses) for date range OR M (Most Recent
  1.  ;   Responses) for date range (by unique Payer/Pat pair)
  1.  ;  IBCNESPC("TRCN")=Trace #^IEN, if non-null all other params are null
  1.  ;  IBCNESPC("RFLAG")=Report Flag used to indicate which report is being
  1.  ;   run.  Response Report (0), Inactive Report (1), or Ambiguous 
  1.  ;   Report (2).
  1.  ;  IBCNESPC("DTEXP")=Expiration date used in the inactive policy report
  1.  ;  IBOUT="R" for Report format or "E" for Excel format
  1.  ;
  1.  ; Only call this routine at a tag
  1.  Q
  1. EN(IPRF) ; Main entry pt
  1.  ; Init vars
  1.  N IBCNERTN,IBCNESPC,IBOUT,POP,STOP
  1.  N IBSTOP ; IB*702 to control initial quit point
  1.  S IPRF=$G(IPRF) ; IB*702
  1.  S IBCNESPC("RFLAG")=$G(IPRF)
  1.  ;
  1.  S STOP=0
  1.  S IBCNERTN="IBCNERP1"
  1.  W @IOF
  1.  W !,"eIV ",$S(IPRF=1:"Inactive Policy",IPRF=2:"Ambiguous Policy",1:"Response")," Report",!
  1.  I $G(IPRF) D
  1.  . ; IB*702/DTG start update initial report statement
  1.  . ;W !,"Please select a date range to view ",$S(IPRF=1:"inactive",1:"ambiguous")," policy information that the eIV"
  1.  . ;W !,"process turned up while attempting to discover previously unknown"
  1.  . ;W !,"insurance policies. (Date range selection is based on the date that"
  1.  . ;W !,"eIV receives the response from the payer.)"
  1.  . ;
  1.  . W !,"Please select a date range in which ",$S(IPRF=1:"inactive",1:"ambiguous")," responses were received to view"
  1.  . W !,"the associated response detail. Date range selection is based on the date"
  1.  . W !,"that eIV receives the response from the payer."
  1.  . ; IB*702/DTG end update initial report statement
  1.  ;
  1.  I '$G(IPRF) D
  1.  . W !,"Insurance verification responses are received daily."
  1.  . W !,"Please select a date range in which responses were received to view the"
  1.  . W !,"associated response detail.  Otherwise, select a Trace # to view specific"
  1.  . W !,"response detail."
  1.  ;
  1.  ; Rpt by Date Range or Trace #
  1. R05 I '$G(IPRF) D RTYPE I STOP G EXIT ;IB*752/CKB - if user entered '^', exit option
  1.  ; If rpt by Trace # - no other criteria is necessary
  1.  I $G(IBCNESPC("TRCN")) G R60
  1.  ; Date Range params
  1.  ; IB*702/DTG start exit if up caret on start date for inactive/ambiguous
  1. R10 ;D DTRANGE I STOP G:$$STOP EXIT G R05
  1.  S IBSTOP=0 D DTRANGE
  1.  I IBSTOP&(IPRF) G EXIT
  1.  I STOP G:$$STOP EXIT G R05
  1.  ; IB*702/DTG end exit if up caret on start date for inactiver/ambiguous
  1.  ; Payer Selection param
  1. R20 D PYRSEL I STOP G:$$STOP EXIT G R10
  1.  ; Patient Selection param
  1. R30 D PTSEL I STOP G:$$STOP EXIT G R20
  1.  ; Type of data to return param
  1. R40 D TYPE I STOP G:$$STOP EXIT G R30
  1.  ; IB*702/DTG start remove policy exp date
  1.  ; How far back do you want the expiration date
  1. R45 ; I $G(IPRF)=1 D DTEXP I STOP G:$$STOP EXIT G R40
  1.  S IBCNESPC("DTEXP")=""
  1.  ; Sort by param - Payer or Patient
  1. R50 ;D SORT I STOP G:$$STOP EXIT G R45
  1.  D SORT I STOP G:$$STOP EXIT G R40
  1.  ; IB*702/DTG end remove policy exp date
  1.  ; Select the output type
  1. R60 S IBOUT=$$OUT I STOP G:$$STOP EXIT G R50
  1.  I IBOUT="E" W !!,"To avoid undesired wrapping, please enter '0;256;999' at the 'DEVICE:' prompt.",!
  1.  ; Select output device
  1.  ; IB*702/DTG start go back 1 if up caret and no to quit
  1. R100 ;D DEVICE(IBCNERTN,.IBCNESPC,IBOUT) I STOP Q:+$G(IBFRB)&($G(IBOUT)="E")  G:$$STOP EXIT G:$G(IBCNESPC("TRCN"))'="" R05 G R50
  1.  D DEVICE(IBCNERTN,.IBCNESPC,IBOUT)
  1.  ;IB*752/DTG remove step back if upcaret and go to exit
  1.  ;I STOP Q:+$G(IBFRB)&($G(IBOUT)="E")  G:$$STOP EXIT G:$G(IBCNESPC("TRCN"))'="" R05 G R60  ; IB*702/DTG start go back 1 if up caret and no to quit
  1.  I STOP G EXIT
  1.  ;
  1. EXIT ; Exit pt
  1.  Q
  1.  ;
  1. COMPILE(IBCNERTN,IBCNESPC,IBOUT) ; 
  1.  ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
  1.  ; Input params:
  1.  ;  IBCNERTN = Routine name for ^TMP($J,...
  1.  ;  IBCNESPC = Array passed by ref of the report params
  1.  ;
  1.  ; Init scratch globals
  1.  K ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X")
  1.  ; Compile
  1.  I IBCNERTN="IBCNERP1" D EN^IBCNERP2(IBCNERTN,.IBCNESPC,IBOUT)
  1.  I IBCNERTN="IBCNERP4" D EN^IBCNERP5(IBCNERTN,.IBCNESPC)
  1.  I IBCNERTN="IBCNERP7" D EN^IBCNERP8(IBCNERTN,.IBCNESPC)
  1.  ; Print
  1.  I '$G(ZTSTOP) D
  1.  . I IBCNERTN="IBCNERP1" D EN3^IBCNERPA(IBCNERTN,.IBCNESPC,IBOUT)
  1.  . I IBCNERTN="IBCNERP4" D EN6^IBCNERPA(IBCNERTN,.IBCNESPC,IBOUT)
  1.  . I IBCNERTN="IBCNERP7" D EN^IBCNERP9(IBCNERTN,.IBCNESPC,IBOUT)
  1.  ; Close device
  1.  D ^%ZISC
  1.  ; Kill scratch globals
  1.  K ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X")
  1.  ; Purge task record
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  ;
  1. COMPILX ; COMPILE exit pt
  1.  Q
  1.  ;
  1. STOP() ; Determine if user wants to exit out of the whole option
  1.  ; Init vars
  1.  N DIR,X,Y,DIRUT
  1.  ;
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to exit out of this option entirely"
  1.  S DIR("B")="YES"
  1.  S DIR("?",1)="  Enter YES to immediately exit out of this option."
  1.  S DIR("?")="  Enter NO to return to the previous question."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S (STOP,Y)=1 G STOPX
  1.  I 'Y S STOP=0
  1.  ;
  1. STOPX ; STOP exit pt
  1.  Q Y
  1.  ;
  1. DTRANGE ; Determine start and end dates for date range param
  1.  ; Init vars
  1.  N X,Y,DIRUT
  1.  ;
  1.  W !
  1.  ;
  1.  S DIR(0)="D^:-NOW:EX"
  1.  S DIR("A")="Start DATE"
  1.  S DIR("?",1)="   Please enter a valid date for which an eIV Response"
  1.  S DIR("?")="   would have been received. Future dates are not allowed."
  1.  D ^DIR K DIR
  1.  ; IB*702/DTG start exit if up caret on start date for inactive/ambiguous
  1.  ;I $D(DIRUT) S STOP=1 G DTRANGX
  1.  I $D(DIRUT) D  G DTRANGX
  1.  . I $G(IPRF)=1!($G(IPRF)=2) S IBSTOP=1 Q
  1.  . S STOP=1
  1.  ; IB*702/DTG end exit if up caret on start date for inactive/ambiguous
  1.  S IBCNESPC("BEGDT")=Y
  1.  ; End date
  1. DTRANG1 S DIR(0)="DA^"_Y_":-NOW:EX"
  1.  S DIR("A")="  End DATE:  "
  1.  S DIR("?",1)="   Please enter a valid date for which an eIV Response"
  1.  S DIR("?",2)="   would have been received.  This date must not precede"
  1.  S DIR("?")="   the Start Date.  Future dates are not allowed."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G DTRANGX
  1.  S IBCNESPC("ENDDT")=Y
  1.  ;
  1. DTRANGX ; DTRANGE exit pt
  1.  Q
  1.  ;
  1. PYRSEL ; Select one payer or ALL - File #365.12
  1.  ; Init vars
  1.  NEW DIC,DTOUT,DUOUT,X,Y
  1.  ;
  1.  W !
  1.  S DIC(0)="ABEQ"
  1.  S DIC("A")=$$FO^IBCNEUT1("Payer or <Return> for All Payers: ",40,"R")
  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.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT) S STOP=1 G PYRSELX
  1.  ; If nothing was selected (Y=-1), select ALL payers
  1.  S IBCNESPC("PYR")=$S(Y=-1:"",1:$P(Y,U,1))
  1.  ;
  1. PYRSELX ; PYRSEL exit pt
  1.  Q
  1.  ;
  1. PTSEL ; Select one patient or ALL - File #2
  1.  ; Init vars
  1.  NEW DIC,DTOUT,DUOUT,X,Y
  1.  ; Patient lookup
  1.  W !
  1.  S DIC(0)="AEQM"
  1.  S DIC("A")=$$FO^IBCNEUT1("Patient or <Return> for All Patients: ",40,"R")
  1.  S DIC="^DPT("
  1.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT) S STOP=1 G PTSELX
  1.  ; If nothing was selected (Y=-1), select ALL patients
  1.  S IBCNESPC("PAT")=$S(Y=-1:"",1:$P(Y,U,1))
  1.  ;
  1. PTSELX ; PTSEL exit pt
  1.  Q
  1.  ;
  1. TYPE ; Prompt to select to display All or Most Recent Responses for
  1.  ; Patient/Payer combos
  1.  ; Init vars
  1.  N DIR,X,Y,DIRUT
  1.  ;
  1.  S DIR(0)="S^A:All Responses;M:Most Recent Responses"
  1.  S DIR("A")="Select the type of responses to display"
  1.  S DIR("B")="A"
  1.  S DIR("?",1)="  A - All responses from the payer during the date range will be"
  1.  S DIR("?",2)="      displayed for each unique payer/patient combination."
  1.  S DIR("?",3)="      (Default)"
  1.  S DIR("?",4)="  M - Only the most recently received response from the payer"
  1.  S DIR("?",5)="      during the date range will be displayed for each unique"
  1.  S DIR("?")="      payer/patient combination."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G TYPEX
  1.  S IBCNESPC("TYPE")=Y
  1.  ;
  1. TYPEX ; TYPE exit pt
  1.  Q
  1.  ;
  1. DTEXP ; Prompt for oldest expiration date to pull for.
  1.  ; Init Vars
  1.  N Y,DIRUT,TODAY
  1.  ;
  1.  W !
  1.  ;
  1.  S DIR(0)="D^:-NOW:EX"
  1.  S DIR("A")="Earliest Policy Expiration Date to Select From"
  1.  S DIR("B")="T-365"
  1.  S DIR("?",1)=" Please enter a valid date in the past. Any policy with a reported"
  1.  S DIR("?")=" expiration date prior to this date will not be selected."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G DTEXPX
  1.  S IBCNESPC("DTEXP")=Y
  1.  ;
  1. DTEXPX ; DTEXP Exit
  1.  Q
  1.  ;
  1. SORT ; Prompt to allow users to sort the report by Payer(default) or 
  1.  ;  Patient
  1.  ; Init vars
  1.  N DIR,X,Y,DIRUT
  1.  ;
  1.  S DIR(0)="S^1:Payer Name;2:Patient Name"
  1.  S DIR("A")="Select the primary sort field"
  1.  S DIR("B")=1
  1.  S DIR("?",1)="  1 - Payer Name is the primary sort, Patient Name is secondary."
  1.  S DIR("?",2)="      (Default)"
  1.  S DIR("?")="  2 - Patient Name is the primary sort, Payer Name is secondary."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G SORTX
  1.  S IBCNESPC("SORT")=Y
  1.  ;
  1. SORTX ; SORT exit pt
  1.  Q
  1.  ;
  1. RTYPE ; Prompt to allow users to report by date range or Trace #
  1.  ; Init vars
  1.  N D,DIC,DIR,X,Y,DIRUT,DTOUT,DUOUT
  1.  ;
  1.  S DIR(0)="S^1:Report by Date Range;2:Report by Trace #"
  1.  S DIR("A")="Select the type of report to generate"
  1.  S DIR("B")=1
  1.  S DIR("?",1)="  1 - Generate report by date range, payer range, patient range"
  1.  S DIR("?",2)="      and All or Most Recent responses for payer/patient."
  1.  S DIR("?",3)="      (Default)"
  1.  S DIR("?",4)="  2 - Generate report for a specific Trace # which corresponds"
  1.  S DIR("?")="      to an unique response."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G RTYPEX
  1.  I Y=1 S IBCNESPC("TRCN")="" G RTYPEX
  1.  ;
  1.  ; Allow user to select Trace # from x-ref "C"
  1.  W !
  1.  S DIC(0)="AEVZSQ"
  1.  S DIC="^IBCN(365,",D="C",DIC("A")="Enter Trace # for report: "
  1.  ; IB*702/TAZ,CKB - added screen for transactions with a "WH" prefix on the Trace #
  1.  S DIC("S")="I $E($P($G(^(0)),U,9),1,2)'=""WH"""
  1.  S DIC("W")="N IBX S IBX=$P($G(^(0)),U,2,3) W:$P(IBX,U,1) $P($G(^DPT($P(IBX,U,1),0)),U,1) W:$P(IBX,U,2) ""  ""_$P($G(^IBE(365.12,$P(IBX,U,2),0)),U,1)"
  1.  D IX^DIC K DIC
  1.  I $D(DTOUT)!$D(DUOUT) S STOP=1 G RTYPEX
  1.  I 'Y!(Y<0) S STOP=1 G RTYPEX
  1.  S IBCNESPC("TRCN")=$P(Y(0),U,9)_"^"_$P(Y,U,1)
  1.  ;
  1. RTYPEX ; RTYPE exit pt
  1.  Q
  1.  ;
  1. DEVICE(IBCNERTN,IBCNESPC,IBOUT) ; Device Handler and possible TaskManager calls
  1.  ;
  1.  ; Input params:
  1.  ;  IBCNERTN = Routine name for ^TMP($J,...
  1.  ;  IBCNESPC = Array passed by ref of the report params
  1.  ;  IBOUT    = "R" for Report format or "E" for Excel format 
  1.  ;
  1.  ; Output params:
  1.  ;  STOP = Flag to stop routine
  1.  ;
  1.  ; Init vars
  1.  N POP,ZTDESC,ZTRTN,ZTSAVE
  1.  ;
  1.  I IBCNERTN="IBCNERP4"!(IBCNERTN="IBCNERPF"&($G(IBCNESPC("TYPE"))="D")) W:$G(IBOUT)="R" !!!,"*** This report is 132 characters wide ***",!
  1.  S ZTRTN="COMPILE^IBCNERP1("""_IBCNERTN_""",.IBCNESPC,"""_IBOUT_""")"
  1.  ; IB*2.0*549 Change name of report from "Patient Insurance Update" to "Auto Update"
  1.  S ZTDESC="IBCNE eIV "_$S(IBCNERTN="IBCNERP1":"Response",IBCNERTN="IBCNERPF":"Auto Update",1:"Payer")_" Report"
  1.  S ZTSAVE("IBCNESPC(")=""
  1.  S ZTSAVE("IBCNERTN")=""
  1.  S ZTSAVE("IBOUT")=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
  1.  I POP S STOP=1
  1.  ;
  1. DEVICEX ; DEVICE exit pt
  1.  Q
  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