- BPSRSRLC ;BHAM ISC/SS - ECME RESEARCH SCREEN RELEASE COPAY ;05-APR-05
- ;;1.0;E CLAIMS MGMT ENGINE;**1,20**;JUN 2004;Build 27
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- RH ;
- N BPRET,BPSEL,DFN,BPRXRF
- I '$D(@(VALMAR)) Q
- D FULL^VALM1
- W !,"Please select a SINGLE Patient Line item or a SINGLE Rx Line item when accessing Release Copay from Hold."
- S BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select a SINGLE Patient Line item or a SINGLE Rx Line item")
- I BPSEL<1 S VALMBCK="R" Q
- S DFN=+$P(BPSEL,U,2)
- I DFN=0 S VALMBCK="R" Q
- I +$P(BPSEL,U,7)>0 D
- . ;RX was selected
- . I $$NB^BPSSCR03(+$P(BPSEL,U,4)) W !!,"This patient does not have any charges 'on hold.'",! D PAUSE^VALM1 Q
- . S BPRXRF=$$RXREF^BPSSCRU2(+$P(BPSEL,U,4))
- . I BPRXRF'>0 Q
- . D RELH^IBNCPDPR(DFN,+$P(BPRXRF,U),+$P(BPRXRF,U,2),"C")
- I +$P(BPSEL,U,7)=0 D
- . ;patient was selected
- . D RELH^IBNCPDPR(DFN,0,0,"P")
- D QUIT
- Q
- ;
- QUIT ;
- S VALMBCK="R"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRSRLC 985 printed Apr 23, 2025@18:07:28 Page 2
- BPSRSRLC ;BHAM ISC/SS - ECME RESEARCH SCREEN RELEASE COPAY ;05-APR-05
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,20**;JUN 2004;Build 27
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- RH ;
- +1 NEW BPRET,BPSEL,DFN,BPRXRF
- +2 IF '$DATA(@(VALMAR))
- QUIT
- +3 DO FULL^VALM1
- +4 WRITE !,"Please select a SINGLE Patient Line item or a SINGLE Rx Line item when accessing Release Copay from Hold."
- +5 SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","PC","Please select a SINGLE Patient Line item or a SINGLE Rx Line item")
- +6 IF BPSEL<1
- SET VALMBCK="R"
- QUIT
- +7 SET DFN=+$PIECE(BPSEL,U,2)
- +8 IF DFN=0
- SET VALMBCK="R"
- QUIT
- +9 IF +$PIECE(BPSEL,U,7)>0
- Begin DoDot:1
- +10 ;RX was selected
- +11 IF $$NB^BPSSCR03(+$PIECE(BPSEL,U,4))
- WRITE !!,"This patient does not have any charges 'on hold.'",!
- DO PAUSE^VALM1
- QUIT
- +12 SET BPRXRF=$$RXREF^BPSSCRU2(+$PIECE(BPSEL,U,4))
- +13 IF BPRXRF'>0
- QUIT
- +14 DO RELH^IBNCPDPR(DFN,+$PIECE(BPRXRF,U),+$PIECE(BPRXRF,U,2),"C")
- End DoDot:1
- +15 IF +$PIECE(BPSEL,U,7)=0
- Begin DoDot:1
- +16 ;patient was selected
- +17 DO RELH^IBNCPDPR(DFN,0,0,"P")
- End DoDot:1
- +18 DO QUIT
- +19 QUIT
- +20 ;
- QUIT ;
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;