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

IBCERP7.m

Go to the documentation of this file. 
  1. IBCERP7 ;AITC/KDM - HID   HCCH Payer ID Report ;5/4/2017
  1.  ;;2.0;INTEGRATED BILLING;**577,592,623**;21-MAR-94;Build 70
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ; This report is a PAYER ID report based on the 277stat msg responses from the clearing house
  1.  ; This report will give a snap shot view of what is on file at the time of running.
  1.  ; The results may vary each running depending on the timing of transactions posted to the file   
  1.  ; Refer to US976
  1.  ; Called by IB BILLING SUPERVISOR MENU, Opt:SYST, Opt:HID
  1.  ;
  1. ENT ; Menu Option Entry Point
  1.  N BEGDT,BEGIN,DT,END,ENDDT,HDR1,HDR2,HDR3,IBABEG,IBAEND,IBEOB,IBIFN,IBQUIT,LNTOT,MAX,PAGES,PGC,RNAME,U,Y
  1.  N ASTERISK,CNT,DASH,EORMSG,LEGEND,NONEMSG,POP
  1.  S (ASTERISK,IBQUIT)=0,RNAME="IBCERP7",LEGEND="'*' = No available fields to allow for an update in the insurance file"
  1.  D DATES Q:IBQUIT  Q:'Y
  1.  D DEVICE Q:POP  Q:IBQUIT
  1. QUE ; Queued Entry Point
  1.  K ^TMP(RNAME,$J)
  1.  D GATHER
  1.  D HDRINIT
  1.  D HEADER Q:IBQUIT
  1.  D PRINT
  1.  D EXIT
  1.  Q
  1. DATES ;  Enter the from and to dates for this report
  1.  ;
  1.  N DIR
  1.  W ! S DIR(0)="DA^:DT:EX",DIR("A")="Enter Earliest Date: ",DIR("B")=$$HTE^XLFDT($H-30),DIR("?")="Enter the earliest transaction date for the transaction report."
  1.  D ^DIR K DIR Q:'Y  S IBABEG=+Y,BEGIN=Y(0),BEGDT=$$FMTE^XLFDT(IBABEG,2)
  1.  ;
  1.  W ! S DIR(0)="DA^"_+Y_":DT:EX",DIR("A")="Enter Latest Date: ",DIR("B")=$$FMTE^XLFDT(DT,1)
  1.  ; DIR("?")="Enter the latest date for the transaction report."
  1.  D ^DIR K DIR Q:'Y  S IBAEND=+Y,END=Y(0),ENDDT=$$FMTE^XLFDT(IBAEND,2)
  1.  ;
  1.  Q
  1.  ;
  1. DEVICE ; - Ask device
  1.  ;
  1.  N %ZIS,ZTDESC,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE
  1.  W !!!,"You will need a 132 column printer for this report",!
  1.  S %ZIS="QM" D ^%ZIS S:POP IBQUIT=1 Q:POP
  1.  I $D(IO("Q")) D  S IBQUIT=1 Q
  1.  . S ZTRTN="QUE^IBCERP7",ZTDESC="HCCH Payer ID Report"
  1.  . S ZTSAVE("BEGIN")=""
  1.  . S ZTSAVE("END")=""
  1.  . S ZTSAVE("IBABEG")=""
  1.  . S ZTSAVE("IBAEND")=""
  1.  . S ZTSAVE("BEGDT")=""
  1.  . S ZTSAVE("ENDDT")=""
  1.  . S ZTSAVE("RNAME")=""
  1.  . S ZTSAVE("IBQUIT")=""
  1.  . D ^%ZTLOAD
  1.  . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1.  . K ZTSK D HOME^%ZIS
  1.  . W !!! I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR    ;pause to see task no.
  1.  U IO
  1.  Q
  1.  ;
  1. GATHER ;GO GET THE INFO BASED ON THE DATES ENTERED
  1.  ; uses ^DIC(36,"AEDIX",DATE,INSURANCE IEN,) to get data within date range.  
  1.  ; If data is within date range sets up ^TMP($J file with all data needed for the report.
  1.  ; ^DIC(36,"AEDIX",DATE,INSURANCE IEN ,EDI ID NUMBER,TYPE "P" OR "I")=EDI ID NUMBER ON FILE ;
  1.  ;
  1.  ;(If  EDI NUMBER ON FILE is null- it is considered  updated, not attempted)
  1.  ;
  1.  ;  Uses the insurance ien from Cross ref to extract the name, address, city, and state from the ^DIC(36,IEN)
  1.  ;  Uses the Type from cross ref as the EDI PayerID for the report. For printing the I="Inst";P="Prof"
  1.  ;  Uses the EDI ID NUMBER from Cross ref to be the NewValue on report.
  1.  ;  Uses the EDI ID NUMBER ON FILE from cross ref to be the OldValue on report
  1.  ;  If the EDI ID NUMBER ON FILE from cross ref is null- set the "updated" value for report to be "Yes", otherwise "No"
  1.  ;
  1.  ;
  1.  N DATE,EDIONFILE,EDINO,IBADDRESS,IBCITY,IBNAME,IBSTATE,IBPIEN,LNCNT,TYPE
  1.  S $P(DASH,"_",132)=""
  1.  S U="^",LNTOT=0,PGC=1,MAX=IOSL
  1.  S DATE=IBABEG-1
  1.  F  S DATE=$O(^DIC(36,"AEDIX",DATE)) Q:DATE=""  Q:DATE>IBAEND  D
  1.  . S IBPIEN="" F  S IBPIEN=$O(^DIC(36,"AEDIX",DATE,IBPIEN)) Q:IBPIEN=""  D
  1.  .. S EDINO="" F  S EDINO=$O(^DIC(36,"AEDIX",DATE,IBPIEN,EDINO)) Q:EDINO=""  D
  1.  ... S TYPE="" F  S TYPE=$O(^DIC(36,"AEDIX",DATE,IBPIEN,EDINO,TYPE)) Q:TYPE=""  D
  1.  .... S EDIONFILE=$G(^DIC(36,"AEDIX",DATE,IBPIEN,EDINO,TYPE))
  1.  .... I EDIONFILE["*" S ASTERISK=1
  1.  .... S IBNAME=$$GET1^DIQ(36,IBPIEN,.01)
  1.  .... S IBADDRESS=$$GET1^DIQ(36,IBPIEN,.111)
  1.  .... S IBCITY=$$GET1^DIQ(36,IBPIEN,.114)
  1.  .... S IBSTATE=$$GET1^DIQ(36,IBPIEN,.115,"I")
  1.  .... S ^TMP(RNAME,$J,IBNAME,DATE,EDINO,TYPE)=IBPIEN_U_IBADDRESS_U_IBCITY_U_IBSTATE_U_EDIONFILE
  1.  .... S LNTOT=LNTOT+1
  1.  Q
  1.  ;
  1. PRINT ;  Print data
  1.  ;  PGC=page ct,LNTOT=no of lines to be printed,LNCNT=when to page break
  1.  ;  MAX=IOSL (device length)
  1.  ;
  1.  N ADDRESS,COMPADDR,CITY,DATE,EDINO,EDIONFILE,IEN,NAME,PID,PIDPOS,STATE,TYPE,UPDATE
  1.  S EORMSG="*** END OF REPORT ***"
  1.  S NONEMSG="* * * N O   D A T A   T O   P R I N T * * *"
  1.  ;
  1.  I '$D(^TMP(RNAME,$J)) W !!!,NONEMSG D END Q
  1.  S NAME="" F  S NAME=$O(^TMP(RNAME,$J,NAME)) Q:NAME=""  D
  1.  . S DATE="" F  S DATE=$O(^TMP(RNAME,$J,NAME,DATE)) Q:DATE=""  D
  1.  .. S EDINO="" F  S EDINO=$O(^TMP(RNAME,$J,NAME,DATE,EDINO)) Q:EDINO=""  D
  1.  ... S TYPE="" F  S TYPE=$O(^TMP(RNAME,$J,NAME,DATE,EDINO,TYPE)) Q:TYPE=""  Q:IBQUIT  D
  1.  .... ;JWS;IB*2.0*592;added 'Dent' for Dental
  1.  .... ;S PID=$S(TYPE="I":"Inst",TYPE="D":"Dent",1:"Prof")
  1.  .... ;/vd - US3995 - IB*2*623 - Modified the above line.
  1.  .... S PID=$S($E(TYPE,1)="I":"Inst",$E(TYPE,1)="D":"Dent",1:"Prof")
  1.  .... S PIDPOS=$S($E(TYPE,2)=2:94,1:82)
  1.  .... ;S NAME=$P(^TMP(RNAME,$J,DATE,IEN,EDINO,TYPE),U,1)
  1.  .... S ADDRESS=$P(^TMP(RNAME,$J,NAME,DATE,EDINO,TYPE),U,2)
  1.  .... S CITY=$P(^TMP(RNAME,$J,NAME,DATE,EDINO,TYPE),U,3)
  1.  .... S STATE=$P(^DIC(5,$P(^TMP(RNAME,$J,NAME,DATE,EDINO,TYPE),U,4),0),U,2)
  1.  .... S EDIONFILE=$P(^TMP(RNAME,$J,NAME,DATE,EDINO,TYPE),U,5)
  1.  .... S UPDATE=$S(EDIONFILE="":"Yes",1:"No")
  1.  .... I LNCNT>MAX D HEADER Q:IBQUIT
  1.  .... ;/vd - US3995 - IB*2*623 Modified the following line.
  1.  .... S COMPADDR=$E(ADDRESS,1,39-$L(CITY)-$L(STATE)-3)_" "_CITY_", "_STATE  ; modified IB*2.0*623 v25
  1.  .... ;W !,$E(NAME,1,30),?33,$E(ADDRESS,1,35)," ",CITY,", ",STATE,?73,$$FMTE^XLFDT(DATE,2),?84,PID,?97,EDIONFILE,?109,EDINO,?121,UPDATE
  1.  .... W !,$E(NAME,1,30),?32,COMPADDR,?72,$$FMTE^XLFDT(DATE,2),?PIDPOS,PID,?105,EDIONFILE,?115,EDINO,?125,UPDATE
  1.  .... S LNCNT=LNCNT+1
  1.  I LNCNT>MAX D HEADER
  1.  Q:IBQUIT
  1. END W !!!,?49,EORMSG,!!!
  1.  I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR    ;pause at end of report
  1.  Q
  1.  ;
  1. HDRINIT ; Initial setting
  1.  ;
  1.  S LNCNT=0
  1.  I PGC=1,$E(IOST,1,2)["C-" W @IOF  ; refresh terminal screen on 1st hdr
  1.  I 'LNTOT S PAGES=1
  1.  I LNTOT,PGC=1 D
  1.  . S LNCNT=0
  1.  . S PAGES=LNTOT/(MAX-10) I PAGES<1 S PAGES=1
  1.  . I PAGES["." S PAGES=$P(PAGES+1,".")    ; if more than one page set whole number
  1.  S HDR1="Clearinghouse Payer ID Report"
  1.  S HDR2=$$FMTE^XLFDT($$NOW^XLFDT,1)
  1.  Q
  1.  ;
  1.  ;
  1.  N DIR,DUOUT
  1.  S LNCNT=0
  1.  I PGC'=1 D  Q:IBQUIT
  1.  . W !
  1.  . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DUOUT) S IBQUIT=1 Q:IBQUIT
  1.  . W @IOF   ; refresh terminal screen on hdr
  1.  W !,HDR1,?43,HDR2,?98,"  Page: "_PGC_" of "_PAGES
  1.  W !,"Timeframe: "_BEGDT_" thru "_ENDDT
  1.  W !!
  1.  ;/vd - US3995 IB*2*623 - The following was changed modified.
  1.  ;W !,"Insurance Co",?33,"Address",?73,"Date",?84,"EDI-PayerID",?97,"OldValue",?109,"NewValue",?121,"Updated"
  1.  W !,"Insurance Co",?32,"Address",?72,"Date",?82,"EDI-PayerID",?94,"CLM-OFC-ID",?105,"OldValue",?115,"NewValue",?125,"Updated"
  1.  W:+ASTERISK !,LEGEND W !,DASH    ;vd - IB*2.0*623 - added legend for US3994.
  1.  S LNCNT=LNCNT+10,PGC=PGC+1
  1.  Q
  1. EXIT() ;clean up and quit
  1.  N ZTREQ
  1.  ; Force a form feed at end of a printer report
  1.  I $E(IOST,1,2)'["C-" W @IOF
  1.  ; handle device closing before exiting
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  I '$D(ZTQUEUED) D ^%ZISC
  1.  K ^TMP(RNAME,$J)
  1.  K BEGIN,BEGDT,ENDDT,IBABEG,IBAEND,IBQUIT,IEN,LNCNT,Y
  1.  Q