IBNCPDPR ;WOIFO/SS - ECME RELEASE CHARGES ON HOLD ;3/6/08 16:23
;;2.0;INTEGRATED BILLING;**276,347,384,452**;21-MAR-94;Build 26
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;==========
;version of "IB MT RELEASE CHARGES" option (^IBRREL) without PATIENT prompt
;(patient is selected from the User Screen)
;designed to use from ECME User Screen (IA #) in order to access Release
;copay functionality from ECME
;
RELH(DFN,IBRXIEN,IBREFL,IBMODE) ; entry point
N IBNUM,IBPT
N IBNCPDPR,IBNCPDPRDEF S IBNCPDPR=1
K IBA,PRCABN,BPX,IBI,IBCNT,IB350
S IB350=0
S IBI=0 F IBNUM=1:1 S IBI=$O(^IB("AH",DFN,IBI)) Q:'IBI S IBA(IBNUM)=IBI
I '$D(IBA) W !!,"This patient does not have any charges 'on hold.'",! D PAUSE^VALM1 G RELHX
;
S IBPT=$$PT^IBEFUNC(DFN) W @IOF,$P(IBPT,"^")," Pt ID: ",$P(IBPT,"^",2),! S I="",$P(I,"-",80)="" W I K I
;if the user selected specific RX/refill
I IBMODE="C" D S:IB350>0 IBNCPDPRDEF=$P(IB350,U,2) ; default response# for list
. ;find item that matches selected RX/refill
. S IBCNT=0
. F S IBCNT=$O(IBA(IBCNT)) Q:+IBCNT=0 D Q:IB350>0
. . S BPX=$P($G(^IB(IBA(IBCNT),0)),U,4)
. . I $P(BPX,":")'=52 Q ;if not RX type
. . I $P($P(BPX,";"),":",2)'=IBRXIEN Q ;if not given RX#
. . I IBREFL>0 I $P($P(BPX,";",2),":",2)'=IBREFL Q ;if not given refill #
. . S IB350=IBA(IBCNT)_"^"_IBCNT
;
I IBMODE="C",IB350=0 D G RELHX
. W !!,"There is no copay charge 'on hold' for this Rx.",!
. D PAUSE^VALM1
. Q
;
; call the routine to display and release charges on hold
D RESUME^IBRREL
;
RELHX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDPR 1614 printed Dec 13, 2024@02:24:47 Page 2
IBNCPDPR ;WOIFO/SS - ECME RELEASE CHARGES ON HOLD ;3/6/08 16:23
+1 ;;2.0;INTEGRATED BILLING;**276,347,384,452**;21-MAR-94;Build 26
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;==========
+5 ;version of "IB MT RELEASE CHARGES" option (^IBRREL) without PATIENT prompt
+6 ;(patient is selected from the User Screen)
+7 ;designed to use from ECME User Screen (IA #) in order to access Release
+8 ;copay functionality from ECME
+9 ;
RELH(DFN,IBRXIEN,IBREFL,IBMODE) ; entry point
+1 NEW IBNUM,IBPT
+2 NEW IBNCPDPR,IBNCPDPRDEF
SET IBNCPDPR=1
+3 KILL IBA,PRCABN,BPX,IBI,IBCNT,IB350
+4 SET IB350=0
+5 SET IBI=0
FOR IBNUM=1:1
SET IBI=$ORDER(^IB("AH",DFN,IBI))
if 'IBI
QUIT
SET IBA(IBNUM)=IBI
+6 IF '$DATA(IBA)
WRITE !!,"This patient does not have any charges 'on hold.'",!
DO PAUSE^VALM1
GOTO RELHX
+7 ;
+8 SET IBPT=$$PT^IBEFUNC(DFN)
WRITE @IOF,$PIECE(IBPT,"^")," Pt ID: ",$PIECE(IBPT,"^",2),!
SET I=""
SET $PIECE(I,"-",80)=""
WRITE I
KILL I
+9 ;if the user selected specific RX/refill
+10 ; default response# for list
IF IBMODE="C"
Begin DoDot:1
+11 ;find item that matches selected RX/refill
+12 SET IBCNT=0
+13 FOR
SET IBCNT=$ORDER(IBA(IBCNT))
if +IBCNT=0
QUIT
Begin DoDot:2
+14 SET BPX=$PIECE($GET(^IB(IBA(IBCNT),0)),U,4)
+15 ;if not RX type
IF $PIECE(BPX,":")'=52
QUIT
+16 ;if not given RX#
IF $PIECE($PIECE(BPX,";"),":",2)'=IBRXIEN
QUIT
+17 ;if not given refill #
IF IBREFL>0
IF $PIECE($PIECE(BPX,";",2),":",2)'=IBREFL
QUIT
+18 SET IB350=IBA(IBCNT)_"^"_IBCNT
End DoDot:2
if IB350>0
QUIT
End DoDot:1
if IB350>0
SET IBNCPDPRDEF=$PIECE(IB350,U,2)
+19 ;
+20 IF IBMODE="C"
IF IB350=0
Begin DoDot:1
+21 WRITE !!,"There is no copay charge 'on hold' for this Rx.",!
+22 DO PAUSE^VALM1
+23 QUIT
End DoDot:1
GOTO RELHX
+24 ;
+25 ; call the routine to display and release charges on hold
+26 DO RESUME^IBRREL
+27 ;
RELHX ;
+1 QUIT
+2 ;
