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

IBRREL.m

Go to the documentation of this file.
  1. IBRREL ;ALB/CPM - RELEASE MEANS TEST CHARGES 'ON HOLD'; Sep 30, 2020@15:16:44
  1. ;;2.0;INTEGRATED BILLING;**95,153,199,347,452,651,663,675,677,630,760**;21-MAR-94;Build 25
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; Entry point for stand-alone 'release' option
  1. I '$D(^IB("AH")) W !!,"There are no patients with charges 'on hold' at this time.",! Q
  1. ;
  1. D HOME^%ZIS
  1. W !!,"This option is used to release Means Test charges which have been"
  1. W !,"placed 'on hold.' Please enter a patient with charges 'on hold,' and these"
  1. W !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
  1. ;
  1. ASK ;
  1. R !,"Select PATIENT NAME: ",X:DTIME G END:"^"[$E(X)
  1. I $E(X,1,2)="??" D HLP1 G ASK
  1. I $E(X)="?" D HLP G ASK
  1. N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
  1. S DIC="^DPT(",DIC(0)="QME" D ^DIC K DIC G ASK:Y<1 S DFN=+Y
  1. ;
  1. K IBA,PRCABN
  1. S IBI=0 F IBNUM=1:1 S IBI=$O(^IB("AH",DFN,IBI)) Q:'IBI S IBA(IBNUM)=IBI
  1. I '$D(IBA) W !!,"This patient does not have any charges 'on hold.'",! G ASK
  1. ;
  1. S IBPT=$$PT^IBEFUNC(DFN) W @IOF,$P(IBPT,"^")," Pt ID: ",$P(IBPT,"^",2),! S I="",$P(I,"-",80)="" W I K I
  1. ;
  1. RESUME ; - display header and list charges
  1. ;
  1. ; *** This tag is also called by ECME routine IBNCPDPR ***
  1. ; Special variable IBNCPDPR will be set to 1 when called from ECME.
  1. ; If this variable is set, then processing in this routine will GOTO tag END and quit rather than go back up
  1. ; and ask for another patient.
  1. ; Also, special variable IBNCPDPRDEF is the entry# in the list if a specific Rx# was chosen from the ECME screen.
  1. ;
  1. ;
  1. W !!,"The following IB Actions ",$S($D(PRCABN):"associated with this bill",1:"for this patient")," are ON HOLD:"
  1. D HDR
  1. ;
  1. ; display the list of IB charges on hold
  1. S IBQ=0 F IBNUM=1:1 Q:'$D(IBA(IBNUM))!IBQ D Q:IBQ
  1. . I $Y+5>IOSL D PAUSE^VALM1 S:$D(DIRUT) IBQ=1 Q:IBQ S $Y=0 D HDR
  1. . S IBN=IBA(IBNUM) D LST
  1. . Q
  1. ;
  1. ; - prompt user to select IB Actions
  1. S DIR(0)="LA^1:"_(IBNUM-1)_"^K:X[""."" X"
  1. S DIR("A")="Select IB Action"_$E("s",IBNUM>2)_" (REF #) to release (or '^' to exit): "
  1. I $G(IBNCPDPRDEF) S DIR("B")=IBNCPDPRDEF ; default value if coming in from ECME
  1. S DIR("?")="^D HELP^IBRREL"
  1. W ! D ^DIR K DIR
  1. I $D(DIRUT)!($D(DUOUT)) G END:($D(PRCABN)!$G(IBNCPDPR)) D END W ! G ASK
  1. ;
  1. S IBRANGE=Y,IBSEQNO=1,IBDUZ=DUZ
  1. ; IB*2.0*630 - Check for duplicate copays
  1. N IBDUPCPY,IBCNTR,IBIEN,IBIENS
  1. S IBIENS="",IBDUPCPY=0
  1. F IBCNTR=1:1 S IBIEN=$P(Y,",",IBCNTR) Q:'IBIEN S IBIENS=$G(IBA(IBIEN)) Q:'IBIENS D Q:IBDUPCPY
  1. . S IBDUPCPY=$$DUPCPYCHK^IBECEA1(IBIENS)
  1. . ; If duplicate copay, display message
  1. . I IBDUPCPY D CPYDISPLAY^IBECEA1(IBIENS,IBDUPCPY)
  1. . Q
  1. ; Send user back to selection prompt if duplicate copays exist
  1. Q:IBDUPCPY
  1. ; End of IB*2.0*630 changes
  1. ;
  1. S DIR(0)="Y",DIR("A")="OK to pass "_$S($P(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable"
  1. D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G END:($D(PRCABN)!$G(IBNCPDPR)) D END W ! G ASK
  1. ;
  1. ; - pass charges to Accounts Receivable
  1. W !!,"Passing charges to Accounts Receivable...",! D HDR
  1. F IBCTR=1:1 S IBNUM=$P(IBRANGE,",",IBCTR) Q:'IBNUM I $D(IBA(IBNUM)) S IBNOS=IBA(IBNUM) D ^IBR,ERR:Y<1 I Y>0 S IBN=IBA(IBNUM) D UPDUCDB(IBN),UPDMH(IBN),LST ; IB*2.0*760
  1. W !!,"The charge"_$E("s",$P(IBRANGE,",",2)>0)_" listed above "_$S($P(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable.",!
  1. ;
  1. I $G(IBNCPDPR) W !! S DIR(0)="E" D ^DIR K DIR G END ; exit for ECME
  1. ;
  1. I '$D(PRCABN) W !! S DIR(0)="E" D ^DIR K DIR D END W ! G ASK
  1. ;
  1. END K DIC,DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBCTR,IBN,IBDA,IBDUZ
  1. K IBFAC,IBI,IBIL,IBRANGE,IBNOS,IBNUM,IBPT,IBQ,IBSEQNO,IBSERV,IBSITE
  1. K IBTOTL,IBTRAN,IBWHER,VA,VAERR,VADM
  1. K:'$D(PRCABN) DFN
  1. Q
  1. ;
  1. ;
  1. HDR ; Display charge header.
  1. N IBLINE S $P(IBLINE,"=",81)=""
  1. W !,IBLINE,!," REF Action ID Bill Type",?42,"Bill #",?51,"Fr/Fl Dt",?61,"To/Rls Dt",?73,"Charge"
  1. W !,IBLINE Q
  1. ;
  1. LST ; Display individual IB Action.
  1. N IBND,IBND1,IBRXN,IBRX,IBRF,IBRDT,IENS,IBECME
  1. S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1)),(IBRXN,IBRX,IBRF,IBRDT,IBECME)=0
  1. I $P(IBND,"^",4)["52:" D
  1. . S IBRXN=+$P($P(IBND,"^",4),":",2) ; Rx ien
  1. . S IBRX=$P($P(IBND,"^",8),"-") ; external Rx#
  1. . S IBRF=+$P($P(IBND,"^",4),":",3) ; fill# or 0 for original fill
  1. . S IBECME=$P($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6) ; ecme# DBIA# 4719
  1. . I IBRF S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
  1. . I 'IBRF S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(+IENS,22)
  1. . Q
  1. ;
  1. W !?1,$J(IBNUM,2),?6,$J(+IBND,9)
  1. W ?19,$S(IBRXN>0:"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),1:$P(IBND,"^",8)) ;IB*2.0*651
  1. W ?42,$P($P(IBND,"^",11),"-",2)
  1. W ?51,$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",14)))
  1. W ?61,$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
  1. W ?70,$J(+$P(IBND,"^",7),9,2)
  1. I IBECME W !?19,"ECME #: ",IBECME
  1. Q
  1. ;
  1. ERR ; Display error message.
  1. W !?1,$J(IBNUM,2),?7,"Error encountered - a separate bulletin has been posted"
  1. Q
  1. ;
  1. HLP ; Display basic help message.
  1. W !!,"Enter: the name of a patient with charges 'on hold,' or"
  1. W !?10,"'??' -- to see all patients with charges 'on hold,' or"
  1. W !?10,"'^' -- to quit this option.",!
  1. Q
  1. ;
  1. HLP1 ; Display all patients with charges 'on hold.'
  1. N DFN,I,IBQ,PID
  1. W !!,"The following patients have charges 'on hold:'"
  1. S (DFN,IBQ)=0 F I=1:1 S DFN=$O(^IB("AH",DFN)) Q:'DFN D:'(I#15) Q:IBQ S PID=$$PT^IBEFUNC(DFN) W !?3,$P(PID,"^"),$J("",10),$P(PID,"^",2)
  1. . R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
  1. W ! Q
  1. ;
  1. HELP ; Help for the 'Select' prompt.
  1. W !!?4,"Please enter a list or range of IB Actions (i.e. 1,3,5 or 2-4,8), none"
  1. W !?4,"greater than ",IBNUM-1,", to be passed to Accounts Receivable, or '^' to quit."
  1. Q
  1. ;
  1. AR ; Accounts Receivable entry point to release charges.
  1. ; Input: PRCABN -- ien of Bill/Accounts Receivable
  1. Q:$D(PRCABN)[0 Q:'$$IB^IBRUTL(PRCABN,1) G RESUME
  1. ;
  1. ;Start - IB*2.0*663
  1. UPDUCDB(IBN) ;Update the Visit Tracking DB with the bill Number
  1. N IBND,IBVSTIEN
  1. Q:IBN=""
  1. S IBND=$G(^IB(IBN,0))
  1. ;IB*2.0*663 If charge successfully passed, extract the bill number and update the visit tracking database if this is a CC URGENT CARE Charge
  1. I $P(IBND,U,11)'="",$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["CC URGENT CARE" D
  1. . ; send update to the Visit Tracking file.
  1. . S IBVSTIEN=$$FNDVST^IBECEA4("ON HOLD",$P(IBND,U,14),$P(IBND,U,2))
  1. . ;ADD THE NOT FOUND MESSAGE HERE?
  1. . D:+IBVSTIEN UPDATE^IBECEA38(IBVSTIEN,2,$P(IBND,U,11),"",1,.IBERROR)
  1. Q
  1. ;End IB*2.0*663
  1. UPDMH(IBN) ; update MH Visit tracking DB IB*2.0*760
  1. N IBATYPE,IBBLNO,IBCDCHK,IBERROR,IBFR,IBMHVST,IBND,IBSTOPDA,Z
  1. I +$G(IBN)'>0 Q
  1. S IBND=^IB(IBN,0)
  1. S IBSTOPDA=$P(IBND,U,20),IBCDCHK=0,IBATYPE=+$P(IBND,U,3),IBFR=+$P(IBND,U,14),IBBLNO=$P(IBND,U,11)
  1. I $P($G(^IBE(350.1,IBATYPE,0)),U)["CC MH" S IBCDCHK=1
  1. I 'IBCDCHK,$$CDCHK^IBECEAMH($$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E"),IBFR) S IBCDCHK=1
  1. I IBBLNO'="",IBCDCHK D
  1. .S IBMHVST=$O(^IBMH(351.83,"D",IBN,"")) Q:'IBMHVST
  1. .D MESS2B^IBECEAMH S Z=$$UPDATE^IBECEAMH(0,IBMHVST,2,IBBLNO,"",1,.IBERROR)
  1. .Q
  1. Q