Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCERP3.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCERP3.m (modified) (1 diff)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCERP3.m

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