- 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 Apr 23, 2025@18:39:23 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 ;
