BPSCT.m

BPSCT ;BHAM ISC/SS - ECME CT EDIT SCREEN ;05-APR-05

 ;;1.0;E CLAIMS MGMT ENGINE;**1,10**;JUN 2004;Build 27

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 ; Reference to CT^IBNCPDPC supported by DBIA 4693

 ;

 Q

CT ;to run from research menu

 N BPRET,BPSEL,BP59,BPZ

 I '$D(@(VALMAR)) Q

 D FULL^VALM1

 W !,"Please select a SINGLE Rx Line item when accessing Claims Tracking."

 S BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE RX line.")

 I BPSEL<1 S VALMBCK="R" Q

 ;

 S BP59=+$P(BPSEL,U,4)

 S BPZ=$$RXREF^BPSSCRU2(BP59)

 D CT^IBNCPDPC(+$P(BPZ,U,1),+$P(BPZ,U,2))   ; call IB with Rx ien and fill# (IA 4693)

 S VALMBCK="R"

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPSCT   688     printed  Dec 13, 2024@01:50:46                                                                                                                                                                                                        Page 2

BPSCT     ;BHAM ISC/SS - ECME CT EDIT SCREEN ;05-APR-05

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**1,10**;JUN 2004;Build 27

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ; Reference to CT^IBNCPDPC supported by DBIA 4693

 +5       ;

 +6        QUIT 

CT        ;to run from research menu

 +1        NEW BPRET,BPSEL,BP59,BPZ

 +2        IF '$DATA(@(VALMAR))

               QUIT 

 +3        DO FULL^VALM1

 +4        WRITE !,"Please select a SINGLE Rx Line item when accessing Claims Tracking."

 +5        SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE RX line.")

 +6        IF BPSEL<1

               SET VALMBCK="R"

               QUIT 

 +7       ;

 +8        SET BP59=+$PIECE(BPSEL,U,4)

 +9        SET BPZ=$$RXREF^BPSSCRU2(BP59)

 +10      ; call IB with Rx ien and fill# (IA 4693)

           DO CT^IBNCPDPC(+$PIECE(BPZ,U,1),+$PIECE(BPZ,U,2))

 +11       SET VALMBCK="R"

 +12       QUIT 

 +13      ;