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

IBCNERPM.m

Go to the documentation of this file. 
  1. IBCNERPM ;AITC/VD - IBCNE eIV PAYER DOD REPORT ;22-JAN-2020
  1.  ;;2.0;INTEGRATED BILLING;**664,668,737**;21-MAR-94;Build 19
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; eIV - Insurance Verification Interface
  1.  ; DOD - Date of Death
  1.  ;
  1.  ; Input parameters: N/A
  1.  ; Other relevant variables ZTSAVED for queueing:
  1.  ;  IBCNERTN = "IBCNERPM" (current routine name for queueing the 
  1.  ;             GENERATE 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 (Patient name) OR 2 (Payer name)
  1.  ;  IBCNESPC("TYPE")=1 (Only Not Deceased Patients)
  1.  ;                   2 (Only Deceased Patients)
  1.  ;                   3 (Both Deceased and Not Deceased Patients)
  1.  ;                   for the selected date range (by Payer)
  1.  ;  IBOUT="R" for Report format or "E" for Excel format
  1.  ;
  1.  ; Only call this routine at a tag
  1.  Q
  1.  ;
  1. EN ; Main entry point
  1.  N IBCNERTN,IBCNESPC,IBOUT,POP,STOP
  1.  S STOP=0
  1.  S IBCNERTN="IBCNERPM"
  1.  W @IOF
  1.  W !,"eIV Payer Date of Death Report",!
  1.  W !,"Electronic Insurance Verification responses are received daily."
  1.  W !,"Please select a Date range in which Date of Death eIV responses were received"
  1.  W !,"to determine the appropriate patient Date of Death information."
  1.  ;
  1.  ; Date Range Selection
  1. R10 D DTRANGE I STOP G:$$STOP EXIT G R10
  1.  ; Payer Selection
  1. R20 D PYRSEL I STOP G:$$STOP EXIT G R10
  1.  ; Type of Deceased Data Selection
  1. R30 D TYPE I STOP G:$$STOP EXIT G R20
  1.  ; Sort Selection
  1. R40 D SORT I STOP G:$$STOP EXIT G R30
  1.  ; Output Type Selection
  1. R50 S (IBCNESPC("IBOUT"),IBOUT)=$$OUT I STOP G:$$STOP EXIT G R40
  1.  I $G(IBCNESPC("IBOUT"))="E" W !!,"To avoid undesired wrapping, please enter '0;132;999' at the 'DEVICE:' prompt.",!
  1.  ; Select output device
  1. R100 D DEVICE(IBCNERTN,.IBCNESPC,IBOUT) I STOP Q:$G(IBOUT)="E"  G:$$STOP EXIT G R50
  1.  G EXIT
  1.  ;
  1. EXIT ; Exit point
  1.  Q
  1.  ;
  1. GENERATE(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.  K ^TMP($J,IBCNERTN)
  1.  D COMPILE(.IBCNESPC)        ; Compile the data
  1.  I '$G(ZTSTOP) D OUTPUT(IBCNERTN,.IBCNESPC)     ; Print Output
  1.  D ^%ZISC                   ; Close device
  1.  ; Kill scratch globals
  1.  K ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X")
  1.  ; Purge task record
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1.  ;
  1. STOP() ; Determine if user wants to exit out of the whole option
  1.  N DIR,X,Y,DIRUT
  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 point
  1.  Q Y
  1.  ;
  1. DTRANGE ; Determine start and end dates for date range param
  1.  ; Initialize variables
  1.  N X,Y,DIRUT
  1.  W !!
  1.  S DIR(0)="D^::EX"
  1.  S DIR("A",1)="eIV RESPONSE RECEIVED DATE:"
  1.  S DIR("A")="Earliest Date Received"
  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.  I $D(DIRUT) S STOP=1 G DTRANGX
  1.  I Y>DT W !!,?3,"Future dates are not allowed.  Please try again." G DTRANGE
  1.  S IBCNESPC("BEGDT")=Y
  1.  ; End date
  1. DTRANG1 ;
  1.  S DIR(0)="D^::EX",DIR("B")="Today"
  1.  S DIR("A")="  Latest Date Received"
  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.  I Y>DT W !!,?3,"Future dates are not allowed.  Please try again." G DTRANG1
  1.  I Y<IBCNESPC("BEGDT") W !!,?3,"Latest date must be greated than Earliest Date.  Please try again." G DTRANG1
  1.  S IBCNESPC("ENDDT")=Y
  1.  ;
  1. DTRANGX ; DTRANGE exit point
  1.  Q
  1.  ;
  1. PYRSEL ; Get Payer(s) selection.
  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("?")="^"
  1.  S DIR(0)="SA^A:All;S:Selected",DIR("B")="A"
  1.  D ^DIR
  1.  I $D(DIRUT) S STOP=1 Q
  1.  ;
  1.  I Y="A" S IBCNESPC("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 IIV to EIV
  1.  S DIC("S")="I $$PYRAPP^IBCNEUT5(""EIV"",$G(Y))'="""""
  1.  S DIC="^IBE(365.12,"
  1. PYRSEL1 ; Prompt for Payer Selection
  1.  W !
  1.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT)!(Y=-1) S STOP=1 K IBCNESPC("PYR") Q
  1.  S IBCNESPC("PYR",$P(Y,U,1))=""
  1.  I $$ANOTHER G PYRSEL1
  1.  Q
  1.  ;
  1. TYPE ; Prompt to select to display All or Most Recent Responses for Patient/Payer combos
  1.  N DIR,X,Y,DIRUT
  1.  W !!,"DECEASED OR NOT DECEASED IN VISTA:"
  1.  S DIR(0)="S^1:Patient is not deceased in VistA;2:Patient is deceased in VistA;3:Both"
  1.  S DIR("A")="Select the type of patient to display"
  1.  S DIR("B")=3
  1.  S DIR("?")="^"
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G TYPEX
  1.  S IBCNESPC("TYPE")=Y
  1.  ;
  1. TYPEX ; TYPE exit point
  1.  Q
  1.  ;
  1. SORT ; Prompt to allow users to sort the report by Patient(default) or Payer
  1.  N DIR,X,Y,DIRUT
  1.  W !
  1.  S DIR(0)="S^1:Patient Name;2:Payer Name"
  1.  S DIR("A")="  Select the primary sort field"
  1.  S DIR("B")=1
  1.  S DIR("?")="^"
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) S STOP=1 G SORTX
  1.  S IBCNESPC("SORT")=Y
  1.  ;
  1. SORTX ; SORT exit point
  1.  Q
  1.  ;
  1. DEVICE(IBCNERTN,IBCNESPC,IBOUT) ; Device Handler and possible TaskManager calls
  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.  N POP,ZTDESC,ZTRTN,ZTSAVE
  1.  W:$G(IBOUT)="R" !!!,"*** This report is 132 characters wide ***",!
  1.  S ZTRTN="GENERATE^IBCNERPM("""_IBCNERTN_""",.IBCNESPC,"""_IBOUT_""")"
  1.  S ZTDESC="eIV Payer Date of Death 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 point
  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.  S DIR("?")="^"
  1.  D ^DIR I $D(DIRUT) S STOP=1 Q ""
  1.  Q Y
  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.  W !
  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. COMPILE(IBCNESPC) ; Compile the data to be included on the report.
  1.  N BEGDT,DOD365,DODEX,DODIN,ENDDT,IBDT,IBPAT,IBPTR,IBPYR,IBRIEN,IBTOT,IBTRNO
  1.  N LSTDT,PATDOB,PATIEN,PATNAM,PATSSN,PATSSN4,PYR,PYRIEN,PYRNAM,SORT,SORT1,SORT2,TYPE
  1.  S BEGDT=IBCNESPC("BEGDT")
  1.  S ENDDT=IBCNESPC("ENDDT")
  1.  S PYR=$G(IBCNESPC("PYR"))
  1.  S SORT=IBCNESPC("SORT")
  1.  S TYPE=IBCNESPC("TYPE")
  1.  ;
  1.  S IBDT=BEGDT-.000001    ; Initialize IBDT to start date
  1.  S LSTDT=ENDDT+.999999   ; Initialize LSTDT to be the latest possible date for the end date.
  1.  ; Loop thru the eIV Response File (#365) by Date/Time Response Rec X-Ref
  1.  F  S IBDT=$O(^IBCN(365,"AD",IBDT)) Q:IBDT=""!(IBDT>LSTDT)  D  Q:$G(ZTSTOP)
  1.  . S PYRIEN=""
  1.  . F  S PYRIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN)) Q:PYRIEN=""  D  Q:$G(ZTSTOP)
  1.  .. I PYR'="A",'$D(IBCNESPC("PYR",PYRIEN)) Q   ; Not a selected Payer.
  1.  .. S PYRNAM=$$GET1^DIQ(365.12,PYRIEN,.01) Q:'$L(PYRNAM)    ; Get the Payer Name.
  1.  .. S PATIEN=""
  1.  .. F  S PATIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN)) Q:PATIEN=""  D  Q:$G(ZTSTOP)
  1.  ... S DODIN=$$GET1^DIQ(2,PATIEN_",",.351,"I")    ; Get Patient Internal DOD Date
  1.  ... I TYPE="1",+DODIN Q    ; User selected "Not Deceased" and this patient has a Deceased Date.
  1.  ... I TYPE="2",'+DODIN Q   ; User selected "Deceased" and this patient does not have a Deceased Date.
  1.  ... S PATNAM=$$GET1^DIQ(2,PATIEN_",",.01)    ; Get Patient Name
  1.  ... S DODEX=$$FMTE^XLFDT($$GET1^DIQ(2,PATIEN_",",.351,"I"),"5DZ")    ; Get Patient DOD Date in mm/dd/yyyy format
  1.  ... S PATSSN=$$GET1^DIQ(2,PATIEN_",",.09),PATSSN4=$E(PATSSN,$L(PATSSN)-3,$L(PATSSN))   ; Get last 4 of SSN.
  1.  ... S PATDOB=$$FMTE^XLFDT($$GET1^DIQ(2,PATIEN_",",.03,"I"),"5DZ")    ; Get Patient DOB Date in mm/dd/yyyy format.
  1.  ... ; Set Sort Fields
  1.  ... S SORT1=$S(SORT=1:PATNAM,1:PYRNAM)
  1.  ... S SORT2=$S(SORT=1:PYRNAM,1:PATNAM)
  1.  ... S IBPTR=""
  1.  ... F  S IBPTR=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN,IBPTR)) Q:IBPTR=""  D
  1.  .... S DOD365=$$FMTE^XLFDT($$GET1^DIQ(365,IBPTR_",",1.16,"I"),"5DZ")   ; Get the DOD for the Reponse Record in mm/dd/yyyy format.
  1.  .... I DOD365="" Q   ; No DOD is being filed with this eIV Response entry.
  1.  .... S IBTRNO=$$GET1^DIQ(365,IBPTR_",",.09)    ; Get the Trace #
  1.  .... S ^TMP($J,IBCNERTN,SORT1,SORT2,IBTRNO)=PATNAM_U_PATSSN4_U_PATDOB_U_DODEX_U_PYRNAM_U_IBTRNO_U_DOD365
  1.  Q
  1.  ;
  1. OUTPUT(IBCNERTN,INCNESPC) ; Generate the output of the report.
  1.  N CRT,DASHES,DDATA,DEFSTAT,DLINE,EORMSG,HDR1,HDR2,IBOUT,IBPGC,IBPXT,LOUT,MAXCNT,NONEMSG
  1.  N PATNAM,PYRNAM,RECVD,SENT,SPACES,SRT1,SRT2,SSN,SSNLEN,TRNO,TSTAMP,TYPE,VDATE,X,Y
  1.  S (IBPGC,IBPXT)=0
  1.  S NONEMSG="* * * N O  D A T A  F O U N D * * *"
  1.  S EORMSG="*** END OF REPORT ***"
  1.  S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
  1.  S IBOUT=$G(IBCNESPC("IBOUT"))  ; Output type
  1.  S TYPE=$G(IBCNESPC("TYPE")) ; report type
  1.  S $P(DASHES,"-",132)=""
  1.  S $P(SPACES," ",40)=""
  1.  S HDR1="Date Range: "_$$FMTE^XLFDT($G(IBCNESPC("BEGDT")),"5Z")_"-"_$$FMTE^XLFDT($G(IBCNESPC("ENDDT")),"5Z")_"       "
  1.  S HDR1=HDR1_$S($G(IBCNESPC("PYR"))="A":"All Payers",1:"Selected Payers")
  1.  S HDR1=HDR1_", Patients "_$S(TYPE="1":"Not ",TYPE="3":"Deceased and Not ",1:"")_"Deceased in VistA"
  1.  S HDR2=""
  1.  I IBOUT="E" S HDR2="Patient Name"_U_"Last 4 SSN"_U_"DOB VISTA"_U_"DOD VISTA"_U_"Payer Name"_U_"Trace #"_U_"DOD Payer"
  1.  I IBOUT="R" S HDR2="Patient Name"_$E(SPACES,1,20)_"Last 4 SSN  DOB VISTA   DOD VISTA   Payer Name"_$E(SPACES,1,31)_"Trace #"_$E(SPACES,1,5)_"DOD Payer"
  1.  ; Determine IO parameters
  1.  S MAXCNT=IOSL-6,CRT=0
  1.  S:IOST["C-" MAXCNT=IOSL-3,CRT=1
  1.  ; print data
  1.  S SRT1=""
  1.  D HEADER I $G(ZTSTOP)!IBPXT Q
  1.  ; If global does not exist - display No Data message
  1.  I '$D(^TMP($J,IBCNERTN)) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) G OUTPUTX
  1.  I IBOUT="E" D  Q:$G(ZTSTOP)!IBPXT
  1.  .; excel format
  1.  .F  S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1=""!$G(ZTSTOP)!IBPXT  D
  1.  ..S SRT2="" F  S SRT2=$O(^TMP($J,IBCNERTN,SRT1,SRT2)) Q:SRT2=""!$G(ZTSTOP)!IBPXT  D
  1.  ...S TRNO=0 F  S TRNO=$O(^TMP($J,IBCNERTN,SRT1,SRT2,TRNO)) Q:TRNO=""  D
  1.  ....S LOUT=^TMP($J,IBCNERTN,SRT1,SRT2,TRNO)
  1.  ....D LINE(LOUT)
  1.  ;
  1.  I IBOUT="R" D  Q:$G(ZTSTOP)!IBPXT
  1.  .; report format
  1.  .F  S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1=""!$G(ZTSTOP)!IBPXT  D
  1.  ..S SRT2="" F  S SRT2=$O(^TMP($J,IBCNERTN,SRT1,SRT2)) Q:SRT2=""!$G(ZTSTOP)!IBPXT  D 
  1.  ...S TRNO=0 F  S TRNO=$O(^TMP($J,IBCNERTN,SRT1,SRT2,TRNO)) Q:TRNO=""  D PRINT
  1.  ;
  1. OUTPUTX ;
  1.  W !
  1.  D LINE($$FO^IBCNEUT1(EORMSG,$$CENTER(EORMSG),"R"))
  1.  I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
  1.  Q
  1.  ;
  1. PRINT ; Get Print Info
  1.  ; "Patient Name",?34,"Last 4 SSN",?44,"DOB VISTA",?56,"DOD VISTA",?68,"Payer Name",?100,"Trace #",?122,"DOD Payer"
  1.  S DDATA=$G(^TMP($J,IBCNERTN,SRT1,SRT2,TRNO)),DLINE=""
  1.  S $E(DLINE,1,30)=$E($P(DDATA,U),1,30)  ;PATIENT NAME
  1.  S $E(DLINE,36,39)=$P(DDATA,U,2)  ;LAST 4 OF SSN
  1.  S $E(DLINE,45,54)=$P(DDATA,U,3)  ;DATE OF BIRTH VISTA
  1.  S $E(DLINE,57,66)=$P(DDATA,U,4)  ;DATE OF DEATH VISTA
  1.  S $E(DLINE,69,108)=$E($P(DDATA,U,5),1,40)  ;PAYER NAME
  1.  S $E(DLINE,110,119)=$P(DDATA,U,6)  ;TRACE #
  1.  S $E(DLINE,122,131)=$P(DDATA,U,7)  ;DATE OF DEATH PAYER
  1.  D LINE(DLINE)
  1.  Q
  1.  ;
  1. EOL ; display "end of page" message and set exit flag
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
  1.  I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  I $D(DTOUT)!$D(DUOUT) S IBPXT=1
  1.  Q
  1.  ;
  1.  N HDR,OFFSET,SRT
  1.  ;
  1.  I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL I IBPXT Q
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 Q
  1.  S IBPGC=IBPGC+1
  1.  W @IOF,!,"eIV Payer Date of Death Report"
  1.  S HDR=TSTAMP_$S(IBOUT="R":"  Page: "_IBPGC,1:""),OFFSET=(132-($L(HDR)+1))
  1.  W ?OFFSET,HDR
  1.  W !,HDR1,!!,HDR2
  1.  I IBOUT'="E" W !,DASHES
  1.  Q
  1.  ;
  1. LINE(LINE) ; Print line of data
  1.  I $Y+1>MAXCNT D HEADER I $G(ZTSTOP)!IBPXT Q
  1.  W !,LINE
  1.  Q
  1.  ;
  1. CENTER(LINE) ; return length of a centered line
  1.  ; LINE - line to center
  1.  N LENGTH,OFFSET
  1.  S LENGTH=$L(LINE),OFFSET=132-$L(LINE)\2
  1.  Q OFFSET+LENGTH
  1.  ;