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

IBCERP3.m

Go to the documentation of this file. 
  1. IBCERP3 ;ALB/TMP - EDI BATCHES WAITING MORE THAN 1 DAY REPORT ;30-SEP-96
  1.  ;;2.0;INTEGRATED BILLING;**137,296,377**;21-MAR-94;Build 23
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. PENDING ; Report of batches not sent after the day the bills in it were extracted - report entry point
  1.  ;
  1.  NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBCLM
  1.  I '$O(^IBA(364.1,"ASTAT","P",0)) W !!,"There are no batches that are Pending Austin Receipt.",! S DIR(0)="E" D ^DIR K DIR G EX
  1.  ;
  1.  ; Ask user if they want to include claim level detail
  1.  S DIR(0)="Y",DIR("A")="Include Claims in each Batch",DIR("B")="Yes"
  1.  W ! D ^DIR K DIR
  1.  I $D(DIRUT) G EX
  1.  S IBCLM=+Y
  1.  ;
  1.  D DEVICE
  1. EX ;
  1.  Q
  1.  ;
  1. DEVICE ; selection of device on which to print report
  1.  NEW ZTRTN,ZTDESC,ZTSAVE,POP
  1.  W !!,"This report is 80 characters wide."
  1.  S ZTRTN="COMPILE^IBCERP3"
  1.  S ZTDESC="REPORT OF BILL BATCHES WAITING AUSTIN RECEIPT AFTER 1 DAY"
  1.  S ZTSAVE("IBCLM")=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
  1. DEVICEX ;
  1.  Q
  1.  ;
  1. COMPILE ; Queued job entrypoint
  1.  N IBBA,IB0,IB1,IEN,IBZ,IBIFN,IB399,CLM,BALDUE,IBSTAT,ARSTAT,IB
  1.  ;
  1.  K ^TMP($J,"IBSORT")
  1.  S IBBA=0
  1.  F  S IBBA=$O(^IBA(364.1,"ASTAT","P",IBBA)) Q:'IBBA  D
  1.  . I $$BCHCHK^IBCEBUL(IBBA) Q    ; Batch check function
  1.  . S IB0=$G(^IBA(364.1,IBBA,0)),IB1=$G(^(1))
  1.  . S:$P(IB0,U,7)="" $P(IB0,U,7)="~"
  1.  . S ^TMP($J,"IBSORT",$P(IB0,U,7),$P(IB0,U,1),IBBA)=$P(IB1,U,6)_U_$P(IB0,U,4)
  1.  . ;
  1.  . I 'IBCLM Q   ; include claim data flag
  1.  . ;
  1.  . ; gather the EDI claim data for this batch
  1.  . S IEN=0 F  S IEN=$O(^IBA(364,"C",IBBA,IEN)) Q:'IEN  D
  1.  .. S IBZ=$G(^IBA(364,IEN,0)),IBIFN=+IBZ,IB399=$G(^DGCR(399,IBIFN,0))
  1.  .. S CLM=$P(IB399,U,1) S:CLM="" CLM="~"
  1.  .. S BALDUE=$G(^DGCR(399,IBIFN,"U1")),BALDUE=$P(BALDUE,U,1)-$P(BALDUE,U,2)
  1.  .. S IBSTAT=$$EXTERNAL^DILFD(399,.13,,$P(IB399,U,13))
  1.  .. S ARSTAT=$$EXTERNAL^DILFD(430,8,,+$P($$BILL^RCJIBFN2(IBIFN),U,2))
  1.  .. S IB=$P(IBZ,U,8)_U_BALDUE_U_$P(IBZ,U,3)_U_IBSTAT_U_ARSTAT
  1.  .. S ^TMP($J,"IBSORT",$P(IB0,U,7),$P(IB0,U,1),IBBA,CLM,IEN)=IB
  1.  .. Q
  1.  . Q
  1.  ;
  1.  D PRINT                         ; print report
  1.  D ^%ZISC                        ; close the device
  1.  K ^TMP($J,"IBSORT")             ; clean up scratch global
  1.  I $D(ZTQUEUED) S ZTREQ="@"      ; purge the task record
  1.  ;
  1. COMPX ;
  1.  Q
  1.  ;
  1. PRINT ; print the report to the specified device
  1.  ;
  1.  NEW CRT,IBPAGE,IBSTOP,IBCT,IBTYP,IBBAT,IBBA,IBV,CLM,IEN,DIR,X,Y,Z
  1.  I IOST["C-" S CRT=1
  1.  E  S CRT=0
  1.  ;
  1.  S IBPAGE=0
  1.  I '$D(^TMP($J,"IBSORT")) D HDR1 W !,?3,"No batches found Pending Austin Receipt for >1 day."
  1.  S (IBSTOP,IBCT)=0
  1.  ;
  1.  S IBTYP=""
  1.  F  S IBTYP=$O(^TMP($J,"IBSORT",IBTYP)) Q:IBTYP=""  D  Q:IBSTOP
  1.  . D HDR1
  1.  . S IBBAT=""
  1.  . F  S IBBAT=$O(^TMP($J,"IBSORT",IBTYP,IBBAT)) Q:'IBBAT!(IBSTOP)  S IBBA=0 F  S IBBA=$O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA)) Q:'IBBA!IBSTOP  S IBV=$G(^(IBBA)) D  Q:IBSTOP
  1.  .. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
  1.  .. W !,?2,IBBAT,?16,$$FMTE^XLFDT($P(IBV,U,1),"5Z"),?42,$P(IBV,U,2)
  1.  .. S IBCT=IBCT+1
  1.  .. I 'IBCLM Q    ; no claim level detail
  1.  .. I $O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,""))="" Q   ; no claim data
  1.  .. ;
  1.  .. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
  1.  .. W !!?5,"Claim",?14,"Seq",?22,"Bal Due",?32,"EDI Stat",?43,"IB Status",?57,"AR Status"
  1.  .. S CLM="" F  S CLM=$O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,CLM)) Q:CLM=""!IBSTOP  S IEN=0 F  S IEN=$O(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,CLM,IEN)) Q:'IEN!IBSTOP  D  Q:IBSTOP
  1.  ... S IBV=$G(^TMP($J,"IBSORT",IBTYP,IBBAT,IBBA,CLM,IEN))
  1.  ... D:$Y>(IOSL-4) HDR1 Q:IBSTOP
  1.  ... W !,?5,CLM,?15,$P(IBV,U,1),?19,$J($FN($P(IBV,U,2),"",2),10),?35,$P(IBV,U,3),?43,$E($P(IBV,U,4),1,11),?57,$E($P(IBV,U,5),1,16)
  1.  ... Q
  1.  .. ;
  1.  .. Q:IBSTOP
  1.  .. D:$Y>(IOSL-4) HDR1 Q:IBSTOP
  1.  .. W !
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I IBSTOP G PRINTX
  1.  D:$Y>(IOSL-4) HDR1 G:IBSTOP PRINTX
  1.  W !!,"Total Number of Batches: ",IBCT
  1.  D:$Y>(IOSL-4) HDR1 G:IBSTOP PRINTX
  1.  W !!?5,"*** End of Report ***"
  1.  I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
  1. PRINTX ;
  1.  Q
  1.  ;
  1. HDR1 ; Report header
  1.  ;
  1.  ; if screen output and page# already exists, do a page break
  1.  I IBPAGE,CRT D  I IBSTOP G HDR1X
  1.  . S DIR(0)="E" D ^DIR K DIR
  1.  . I 'Y S IBSTOP=1
  1.  . Q
  1.  ;
  1.  ; if screen output OR page# already exists, do a form feed
  1.  I IBPAGE!CRT W @IOF
  1.  ;
  1.  S IBPAGE=IBPAGE+1
  1.  ;
  1.  W !,"EDI Batches Pending Austin Receipt After 1 Day",?70,"Page: ",IBPAGE
  1.  W !,"Run Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1.  W !!?2,"Batch #",?16,"Transmission Date",?42,"Mail Message #"
  1.  S Z="",$P(Z,"-",79)="" W !?1,Z
  1.  ;
  1.  ; check for a TaskManager stop request
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD() D  G HDR1X
  1.  . S (ZTSTOP,IBSTOP)=1
  1.  . W !!!?5,"*** Report Halted by TaskManager Request ***"
  1.  . Q
  1. HDR1X ;
  1.  Q
  1.  ;