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

IBCEM03.m

Go to the documentation of this file. 
  1. IBCEM03 ;ALB/TMP - 837 EDI RESUBMIT INDIVIDUAL BILL PROCESSING ;17-SEP-96
  1.  ;;2.0;INTEGRATED BILLING;**137,199,296,348,349,592,623,641**;21-MAR-94;Build 61
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. BILL2 ; Resubmit a transmitted bill with a new batch #
  1.  N DIC,DIR,DIE,DA,DR,IB,IB0,IBDA,IBDA1,IBE,IBSTAT,IBBDA,IBOK,IBNEW,Y,ZTSK,IBTEST
  1.  K ^TMP("IBEDI_TEST_BATCH",$J)
  1.  ;
  1.  S DIR("A")="ARE YOU RESUBMITTING CLAIMS FOR TESTING?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q
  1.  I +Y S ^TMP("IBEDI_TEST_BATCH",$J)=1
  1. ASK N DPTNOFZY S DPTNOFZY=1  ;Suppress PATIENT file fuzzy lookups
  1.  S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
  1.  ; Only auth or printed transmittable bill valid for non-test
  1.  ; All previously transmitted valid for test
  1.  S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")=$S('IBTEST:"I $P($G(^(""TX"")),U,2),$P($G(^(0)),U,13)'="""",""234""[$P($G(^(0)),U,13)",1:"I $O(^IBA(364,""B"",+Y,0))")
  1.  I IBTEST S DIC("A")="Select BILL/CLAIMS BILL NUMBER (FOR RESUBMIT AS TEST): "
  1.  D ^DIC K DIC
  1.  I Y<0 D  Q
  1.  . Q:'IBTEST
  1.  . I $O(^TMP("IBEDI_TEST_BATCH",$J,0)) D
  1.  .. M ^TMP("IBRESUBMIT",$J)=^TMP("IBEDI_TEST_BATCH",$J)
  1.  .. D ONE^IBCE837
  1.  . ;
  1.  . K ^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBRESUBMIT",$J)
  1.  ;
  1.  S IBIFN=+Y,IBDA=+$$LAST364^IBCEF4(IBIFN),IB0=$G(^IBA(364,IBDA,0)),IBSTAT=$P(IB0,U,3)
  1.  ;
  1.  I IB0="" W !,"Bill does not exist in BILL TRANSMISSION file" G ASK
  1.  I IBTEST,$D(^TMP("IBEDI_TEST_BATCH",$J,IBDA)) W !,"Bill already selected for test transmission" G ASK
  1.  I $$COBN^IBCEF(IBIFN)=1,IBTEST S IBOK=1 D  G:'IBOK ASK
  1.  . S DIR("A")="BILL IS A PRIMARY BILL, ARE YOU SURE YOU WANT TO SEND IT AS A TEST CLAIM?: "
  1.  . S DIR("B")="NO",DIR(0)="YA" W ! D ^DIR K DIR
  1.  . I Y'=1 S IBOK=0
  1.  ;
  1.  I 'IBTEST,IBSTAT="X" W !,"Bill is currently awaiting extract - will be submitted with next batch run" G ASK
  1.  S IBBDA=+$P(IB0,U,2),IB=$P($G(^IBA(364.1,IBBDA,0)),U,9)
  1.  ;
  1.  I IB,'IBTEST D  G:'IBOK ASK
  1.  . S IBOK=1,ZTSK=IB D STAT^%ZTLOAD
  1.  . I ZTSK(0)=0 S DIE="^IBA(364.1,",DA=IBBDA,DR=".09///@" D ^DIE Q  ;Task not scheduled - delete task #
  1.  . I "125"[ZTSK(1) W *7,!,"Cannot resubmit this bill.",!,"This bill's current batch is already ",$S("2"[ZTSK(1):"being resubmitted",1:"scheduled for resubmission")," - Task # is: ",IB,! S IBOK=0
  1.  ;
  1.  W !
  1.  S DIR("A",1)="   Previously In Batch #: "_$$EXPAND^IBTRE(364,.02,$P(IB0,U,2))
  1.  S DIR("A",2)="Bill Transmission Status: "_$$EXPAND^IBTRE(364,.03,IBSTAT)
  1.  S DIR("A",3)="             Status Date: "_$$FMTE^XLFDT($P(IB0,U,4),2)
  1.  S DIR("A",5)=" "
  1.  S DIR("A",4)="     Current Bill Status: "_$$EXPAND^IBTRE(399,.13,$P($G(^DGCR(399,+IBIFN,0)),U,13))
  1.  I 'IBTEST,IBSTAT'="P" S DIR("A",11)="WARNING - BILL TRANSMITTED PREVIOUSLY" S:IBSTAT?1"A".E DIR("A",11)=DIR("A",11)_" & CONFIRMED AS RECEIVED BY "_$P("AUSTIN^GENTRAN^INTERMEDIARY^CARRIER",U,$TR(IBSTAT,"A")+1)
  1.  S DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT THIS BILL"_$S('IBTEST:"",1:" AS A TEST CLAIM")_"?: "
  1.  S DIR(0)="YA",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  ;
  1.  W ! G:'Y ASK
  1.  ;
  1.  I IBTEST S ^TMP("IBEDI_TEST_BATCH",$J,IBDA)="" G ASK
  1.  ;
  1.  S IBDA1=+$$ADDTBILL^IBCB1(IBIFN) ;Add a new transmit bill record
  1.  ;
  1.  S Y=$$TX1^IBCB1(IBDA1,1)
  1.  ;
  1.  I 'Y D  G ASK
  1.  . W !,*7,"An error has occurred ... bill NOT re-submitted!!"
  1.  . S DIK="^IBA(364,",DA=IBDA1 D:DA ^DIK
  1.  . L -^IBA(364,IBDA)
  1.  ;
  1.  S IBNEW=$P($G(^IBA(364,+IBDA1,0)),U,2)
  1.  ;
  1.  ;Update the old transmit bill record
  1.  D UPDEDI^IBCEM(IBDA,"R")
  1.  ;
  1.  W !,"Bill # ",$P($G(^DGCR(399,+IB0,0)),U)," was re-submitted in batch # ",$P($G(^IBA(364.1,+IBNEW,0)),U)
  1.  ;
  1.  L -^IBA(364,IBDA)
  1.  G ASK
  1.  ;
  1. PRINT1(IBIFN,IBDA,IB364,IBRESUB,IBRESULT) ; Print bill, submit manually as resolution ;WCJ;IB641;US3380; added IBRESULT
  1.  ; for a returned message
  1.  ; IBIFN = ien of bill in file 399
  1.  ; IBDA = array returned from selection of message
  1.  ; IB364 = ien of transmit bill entry in file 364
  1.  ; IBRESUB = flag to indicate if bill is being resubmitted via print
  1.  ; IBRESULT = flag to see if print was successful
  1.  ;
  1.  N IBAC,IBV,IB399,DFN,ZTSK,PRCASV,IBHOLD,IBTXPRT
  1.  S IBRESULT=0  ;WCJ;IB641;US3380; default to unsuccessful completion
  1.  W !
  1.  I IBIFN="" S IBDA="" G PRINT1Q
  1.  S IB399=$G(^DGCR(399,IBIFN,0))
  1.  I "34"'[$P(IB399,U,13) W !,*7,"Bill status must be AUTHORIZED or PRNT/TX to print the bill" S IBDA="" G PRINT1Q
  1.  ;
  1.  I $P($G(^DGCR(399,IBIFN,"S")),U,14)=DT W !,*7,"This bill was last printed today.  You must wait at least 1 day from the last",!,"print date to print this bill using this function." S IBDA="" D PAUSE^VALM1 G PRINT1Q
  1.  ;
  1.  S IBV=1,IBAC=4,DFN=$P(IB399,U,2),IBTXPRT=0
  1.  M IBHOLD("IBDA")=IBDA
  1.  ;D 4^IBCB1,ENS^%ZISS   ;WCJ;IB641;US3380
  1.  D ALT4^IBCB1(.IBRESULT),ENS^%ZISS  ;WCJ;IB641;US3380;adding parameter
  1.  M IBDA=IBHOLD("IBDA")
  1.  ;
  1.  I 'IBTXPRT W !,"Bill was not printed" S IBDA="" G PRINT1Q
  1.  ;
  1.  S IBRESULT=1 ;WCJ;IB641;US3380; got past the not printed message so we must have printed, am I right?
  1.  ;
  1.  D UPDEDI^IBCEM(IB364,"P")
  1.  ;
  1. PRINT1Q Q
  1.  ;
  1. SUB1 ; Select bills in ready for extract status to transmit individually
  1.  N IB0,IB399,IBDA,IBIFN,IBSEL,IBU,X,Y,DA,DIC,Z,DIR
  1.  K ^TMP("IBSELX",$J)
  1.  ;
  1.  S IBSEL=""
  1.  F  D  Q:'IBSEL
  1.  . S DIR("S")="I $P(^(0),U,3)=""X"""
  1.  . S DIR(0)="PAO^364:AEMQ",DIR("A")="SELECT "_$S($D(^TMP("IBSELX",$J)):"NEXT ",1:"")_"BILL TO TRANSMIT: "
  1.  . S DIR("?")="ONLY BILLS IN 'READY FOR EXTRACT' STATUS CAN BE TRANSMITTED WITH THIS OPTION"
  1.  . D ^DIR K DIR
  1.  . I Y'>0 K:Y=U ^TMP("IBSELX",$J) S IBSEL="" Q
  1.  . S IBSEL=+Y
  1.  . S IBDA=+Y,IB0=$G(^IBA(364,IBDA,0)),IBIFN=+IB0,IBU=$G(^DGCR(399,IBIFN,"U")),IB399=$G(^(0))
  1.  . S Z=+$$NEEDMRA^IBEFUNC(IBIFN)
  1.  . I '$$TXMT^IBCEF4(IBIFN,.IBNOTX),IBNOTX=2 D  Q
  1.  .. W !,$S(Z:"MRA",1:"EDI")_" TRANSMISSION PARAMETER HAS BEEN TURNED OFF",!!,"BILL CANNOT BE SELECTED"
  1.  . ;
  1.  . W !
  1.  . ;JWS;IB*2.0*592; added form #7 J430D to display
  1.  . S DIR("A",1)="      YOU HAVE SELECTED BILL #: "_$P(IB399,U)_"  ("_$S($$INPAT^IBCEF(IBIFN):"INPATIENT",1:"OUTPATIENT")_"/"_$S($$FT^IBCEF(IBIFN)=3:"UB-04",$$FT^IBCEF(IBIFN)=7:"J430D",1:"CMS-1500")_" FORMAT)"
  1.  . S DIR("A",2)="                  PATIENT NAME: "_$E($P($G(^DPT(+$P(IB399,U,2),0)),U)_$J("",28),1,28)_"  SSN: "_$P($G(^DPT(+$P(IB399,U,2),0)),U,9)
  1.  . S DIR("A",3)="                  CARE DATE(S): "_$$EXPAND^IBTRE(399,151,$P(IBU,U))_" - "_$$EXPAND^IBTRE(399,152,$P(IBU,U,2))
  1.  . S DIR("A",4)="'READY TO EXTRACT' STATUS DATE: "_$$EXPAND^IBTRE(364,.04,$P(IB0,U,4))
  1.  . S DIR("?",1)=" "
  1.  . S DIR("A",5)=" ",DIR("?")="IF THIS IS THE BILL YOU WANT TO TRANSMIT, RESPOND YES, OTHERWISE, RESPOND NO"
  1.  . S DIR("A")="ARE YOU SURE THIS IS THE CORRECT BILL TO TRANSMIT?: "
  1.  . S DIR(0)="YAO",DIR("B")="NO" D ^DIR K DIR W !
  1.  . I Y'=1 W !,"BILL NOT SELECTED" Q
  1.  . ;
  1.  . S ^TMP("IBSELX",$J,IBDA)=""
  1.  ;
  1.  I '$O(^TMP("IBSELX",$J,0)) G SUB1Q
  1.  ;
  1.  W !,"Bills to be transmitted: "
  1.  S Z=0 F  S Z=$O(^TMP("IBSELX",$J,Z)) Q:'Z  W !,?8,$P($G(^DGCR(399,+$G(^IBA(364,Z,0)),0)),U)
  1.  W !
  1.  S DIR("A")="OK TO TRANSMIT NOW?: ",DIR(0)="YA0",DIR("B")="NO" D ^DIR K DIR
  1.  G:Y'=1 SUB1Q
  1.  W !
  1.  S ^TMP("IBSELX",$J)=0
  1.  D ONE^IBCE837
  1.  ;JWS;IB*2.0*623;if 837 FHIR enabled, display appropriate message
  1.  I $$GET1^DIQ(350.9,"1,",8.21,"I") D  G SUB1Q
  1.  . W !,"BILL(s) placed onto 837 FHIR Transaction list. They will be submitted shortly..."
  1.  W !,"BILL(s) TRANSMITTED ... BATCH #(s): "
  1.  S Z=0 F  S Z=$O(^TMP("IBCE-BATCH",$J,Z)) Q:'Z  W Z,$S($O(^(Z)):", ",1:"")
  1.  I '$O(^TMP("IBCE-BATCH",$J,0)) W !,"NO BILL(S) TRANSMITTED - CHECK ALERTS/MAIL FOR DETAILS"
  1.  ;
  1. SUB1Q D PAUSE^VALM1
  1.  K ^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J)
  1.  Q
  1.  ;