- BPSELG ;ALB/DRF - ECME SCREEN ELIGIBILITY VERIFICATION SUBMIT ;8/13/10 21:14
- ;;1.0;E CLAIMS MGMT ENGINE;**10,11**;JUN 2004;Build 27
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; reference to ^DIR supported by DBIA 10026
- ; references to FULL^VALM1 and PAUSE^VALM1 supported by DBIA 10016
- ; reference to $$FMTE^XLFDT supported by DBIA 10103
- ;
- ;ECME Eligibility Verification w/EDITS Protocol (Hidden) - Called by [BPS USER SCREEN]
- ;
- RESED N BPSEL
- ;
- I '$D(@(VALMAR)) G XRESED
- D FULL^VALM1
- ;
- ;Select the claim to submit
- W !,"Enter the line number for the claim to be submitted for Eligibility Verification"
- S BPSEL=$$ASKLINE("Select item","Please select a SINGLE claim only when using the Eligibility action option.")
- I BPSEL<1 S VALMBCK="R" G XRESED
- ;
- ;Attempt to submit the claim for eligibility
- D DOSELCTD(BPSEL)
- S VALMBCK="R"
- ;
- XRESED Q
- ;
- ;Attempt to Edit and Submit Selected Claim for Eligibility
- ;
- ; Input Value -> BPRXI - Entry with ptr to BPS TRANSACTION file
- ;
- ; Return Value -> 0 - Claim was not submitted
- ; 1 - Claim was submitted
- ;
- DOSELCTD(BPRXI) ;
- N BP02,BP59,BPRSLT,BPCLTOT,BPDFN,BPDOSDT,BPOVRIEN,BPQ,BPRXIEN,BPRXR,BPSTATUS,BPSELG,BPPROMPT,BPPSNCD,BPRELCD,BPUPDFLG
- S (BPQ)=""
- S (BPCLTOT,BPUPDFLG,BPRSLT)=0
- ;
- ;Pull BPS TRANSACTION/BPS CLAIMS entries
- S BP59=$P(BPRXI,U,4) I BP59="" W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",! G XRES
- S BP02=+$P($G(^BPST(BP59,0)),U,4) I 'BP02 W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",! G XRES
- ;
- ;Write Form Feed
- W @IOF
- ;
- ;Display selected claim and ask to submit
- S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
- W !,"You've chosen to VERIFY Eligibility of the following prescription for "_$E($$PATNAME^BPSSCRU2(BPDFN),1,13)
- W !,@VALMAR@(+$P(BPRXI,U,5),0)
- S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
- I BPQ'=1 S BPQ="^" G XRES
- ;
- ;Check to make sure claim can be Submitted for Eligibility
- S BPRXIEN=$P(BP59,".")
- S BPRXR=+$E($P(BP59,".",2),1,4)
- S BPSTATUS=$P($$CLAIMST^BPSSCRU3(BP59),U)
- I BPSTATUS'["E REJECTED" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is NOT Rejected and cannot be Submitted for Eligibility Verification",! G XRES
- ;
- ;Prompt for EDIT Information
- S BPPROMPT=$$PROMPTS(BP02,.BPDOSDT,.BPRELCD,.BPPSNCD) I BPPROMPT=-1 G XRES
- ;
- ;Send eligibility verification
- S BPSELG("PLAN")=$P($G(^BPST(BP59,10,1,0)),U,1) ;IEN to the GROUP INSURANCE PLAN (#355.3) file
- S BPSELG("DOS")=BPDOSDT ;Date of Service entered by the user
- S BPSELG("IEN")=+$P($G(^BPST(BP59,1)),U,11) ;Prescription, if available
- S BPSELG("FILL NUMBER")=+$P($G(^BPST(BP59,1)),U,1) ;Fill Number, if available
- S BPSELG("REL CODE")=BPRELCD
- S BPSELG("PERSON CODE")=BPPSNCD
- S BPRSLT=$$EN^BPSNCPD9(BPDFN,.BPSELG)
- ;
- ;Print Return Value Message
- W !!
- W $P(BPRSLT,U,2)
- ;
- XRES ;
- D PAUSE^VALM1
- Q
- ;
- ; Input Values -> BP02 - The BPS CLAIMS entry
- ;
- ; Output Value -> BPQ - -1 - The user chose to quit
- ; "" - The user completed the EDITS
- ; BPDOSDT - Effective Date of Eligibility Verification transaction
- ; BPRELCD - Patient Relationship Code from file #9002313.19
- ; BPPSNCD - Person Code assigned by payer. 1 - 3 characters free text
- ;
- PROMPTS(BP02,BPDOSDT,BPRELCD,BPPSNCD) ;
- I '$G(BP02) S BPQ=-1 G XPROMPTS
- N %,BP300,BPFDA,BPFLD,BPMED,BPMSG,BPQ,DIC,DIR,DIROUT,DTOUT,DUOUT,X,Y,DIRUT
- S BPQ=""
- ;
- ;Pull Information from Claim
- S BP300=$G(^BPSC(BP02,300))
- S BPRELCD=$TR($E($P(BP300,U,6),3,99)," ")
- S BPPSNCD=$TR($E($P(BP300,U,3),3,99)," ")
- S BPDOSDT=$$DOSDATE^BPSSCRRS(BPRXIEN,BPRXR)
- ;
- ;Effective Date
- S DIR(0)="DO",DIR("A")="Effective Date"
- K DIR("?") S DIR("?")="Enter the effective date for the Eligibility Verification transaction"
- S DIR("B")=$$FMTE^XLFDT(BPDOSDT,"5ZD")
- D ^DIR
- I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS
- S BPDOSDT=Y
- ;
- ;Relationship Code
- N X,DIC,Y
- S DIC("B")=BPRELCD
- S DIC(0)="QEAM",DIC=9002313.19,DIC("A")="Relationship Code: "
- D ^DIC
- ;Check for "^" or timeout
- I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS
- S BPRELCD=$P(Y,U,2)
- K X,DIC,Y
- ;
- ;Person Code
- K DIR("?") S DIR(0)="FO^1:3",DIR("A")="Person Code",DIR("?")="Enter the Specific Person Code Assigned to the Patient by the Payer"
- S DIR("B")=BPPSNCD
- D ^DIR
- I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS
- S BPPSNCD=Y
- ;
- ;Ask to proceed
- W ! S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
- I BPQ'=1 S BPQ=-1 G XPROMPTS
- ;
- XPROMPTS ;
- Q BPQ
- ;
- ;Prompt User for Claim to Resubmit (w/EDITS)
- ;
- ; Input values -> BPROMPT - prompt string
- ; BPERRMES - the message to display when the user tries
- ; to make multi line selection (optional)
- ; Piece
- ;output values -> 1 - 1 = okay, <0 = errors, 0 = quit
- ; 2 - patient ien #2
- ; 3 - insurance ien #36
- ; 4 - ptr to #9002313.59
- ; 5 - 1st line for index(es) in LM "VALM" array
- ; 6 - patient's index
- ; 7 - claim's index
- ;
- ASKLINE(BPROMPT,BPERRMES) ;
- N BPRET,BPCNT
- S BPRET="",BPCNT=0
- F S BPRET=$$SELLINE^BPSSCRU4(BPROMPT,"C",VALMAR,"") Q:BPRET'<0 D
- . I BPCNT<1 S BPCNT=BPCNT+1 W !
- . E S BPCNT=0 D RE^VALM4
- . I BPRET=-1 W "Invalid line number" ; (invalid Patient summary line)"
- . I BPRET=-8 W $S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number")
- . I BPRET=-4 W "Invalid line number" ; (invalid RX line)"
- . I BPRET=-2 W "Please select Patient's summary line."
- . I BPRET=-3 W "Please specify RX line."
- . I ",-1,-8,-4,-2,-3,"'[(","_BPRET_",") W "Incorrect format." ; Corrupted array (",BPRET,")"
- Q BPRET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSELG 5922 printed Feb 18, 2025@23:17:18 Page 2
- BPSELG ;ALB/DRF - ECME SCREEN ELIGIBILITY VERIFICATION SUBMIT ;8/13/10 21:14
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**10,11**;JUN 2004;Build 27
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; reference to ^DIR supported by DBIA 10026
- +5 ; references to FULL^VALM1 and PAUSE^VALM1 supported by DBIA 10016
- +6 ; reference to $$FMTE^XLFDT supported by DBIA 10103
- +7 ;
- +8 ;ECME Eligibility Verification w/EDITS Protocol (Hidden) - Called by [BPS USER SCREEN]
- +9 ;
- RESED NEW BPSEL
- +1 ;
- +2 IF '$DATA(@(VALMAR))
- GOTO XRESED
- +3 DO FULL^VALM1
- +4 ;
- +5 ;Select the claim to submit
- +6 WRITE !,"Enter the line number for the claim to be submitted for Eligibility Verification"
- +7 SET BPSEL=$$ASKLINE("Select item","Please select a SINGLE claim only when using the Eligibility action option.")
- +8 IF BPSEL<1
- SET VALMBCK="R"
- GOTO XRESED
- +9 ;
- +10 ;Attempt to submit the claim for eligibility
- +11 DO DOSELCTD(BPSEL)
- +12 SET VALMBCK="R"
- +13 ;
- XRESED QUIT
- +1 ;
- +2 ;Attempt to Edit and Submit Selected Claim for Eligibility
- +3 ;
- +4 ; Input Value -> BPRXI - Entry with ptr to BPS TRANSACTION file
- +5 ;
- +6 ; Return Value -> 0 - Claim was not submitted
- +7 ; 1 - Claim was submitted
- +8 ;
- DOSELCTD(BPRXI) ;
- +1 NEW BP02,BP59,BPRSLT,BPCLTOT,BPDFN,BPDOSDT,BPOVRIEN,BPQ,BPRXIEN,BPRXR,BPSTATUS,BPSELG,BPPROMPT,BPPSNCD,BPRELCD,BPUPDFLG
- +2 SET (BPQ)=""
- +3 SET (BPCLTOT,BPUPDFLG,BPRSLT)=0
- +4 ;
- +5 ;Pull BPS TRANSACTION/BPS CLAIMS entries
- +6 SET BP59=$PIECE(BPRXI,U,4)
- IF BP59=""
- WRITE !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",!
- GOTO XRES
- +7 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
- IF 'BP02
- WRITE !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",!
- GOTO XRES
- +8 ;
- +9 ;Write Form Feed
- +10 WRITE @IOF
- +11 ;
- +12 ;Display selected claim and ask to submit
- +13 SET BPDFN=+$PIECE($GET(^BPST(BP59,0)),U,6)
- +14 WRITE !,"You've chosen to VERIFY Eligibility of the following prescription for "_$EXTRACT($$PATNAME^BPSSCRU2(BPDFN),1,13)
- +15 WRITE !,@VALMAR@(+$PIECE(BPRXI,U,5),0)
- +16 SET BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
- +17 IF BPQ'=1
- SET BPQ="^"
- GOTO XRES
- +18 ;
- +19 ;Check to make sure claim can be Submitted for Eligibility
- +20 SET BPRXIEN=$PIECE(BP59,".")
- +21 SET BPRXR=+$EXTRACT($PIECE(BP59,".",2),1,4)
- +22 SET BPSTATUS=$PIECE($$CLAIMST^BPSSCRU3(BP59),U)
- +23 IF BPSTATUS'["E REJECTED"
- WRITE !!,"The claim: ",!,@VALMAR@(+$PIECE(BPRXI,U,5),0),!,"is NOT Rejected and cannot be Submitted for Eligibility Verification",!
- GOTO XRES
- +24 ;
- +25 ;Prompt for EDIT Information
- +26 SET BPPROMPT=$$PROMPTS(BP02,.BPDOSDT,.BPRELCD,.BPPSNCD)
- IF BPPROMPT=-1
- GOTO XRES
- +27 ;
- +28 ;Send eligibility verification
- +29 ;IEN to the GROUP INSURANCE PLAN (#355.3) file
- SET BPSELG("PLAN")=$PIECE($GET(^BPST(BP59,10,1,0)),U,1)
- +30 ;Date of Service entered by the user
- SET BPSELG("DOS")=BPDOSDT
- +31 ;Prescription, if available
- SET BPSELG("IEN")=+$PIECE($GET(^BPST(BP59,1)),U,11)
- +32 ;Fill Number, if available
- SET BPSELG("FILL NUMBER")=+$PIECE($GET(^BPST(BP59,1)),U,1)
- +33 SET BPSELG("REL CODE")=BPRELCD
- +34 SET BPSELG("PERSON CODE")=BPPSNCD
- +35 SET BPRSLT=$$EN^BPSNCPD9(BPDFN,.BPSELG)
- +36 ;
- +37 ;Print Return Value Message
- +38 WRITE !!
- +39 WRITE $PIECE(BPRSLT,U,2)
- +40 ;
- XRES ;
- +1 DO PAUSE^VALM1
- +2 QUIT
- +3 ;
- +4 ; Input Values -> BP02 - The BPS CLAIMS entry
- +5 ;
- +6 ; Output Value -> BPQ - -1 - The user chose to quit
- +7 ; "" - The user completed the EDITS
- +8 ; BPDOSDT - Effective Date of Eligibility Verification transaction
- +9 ; BPRELCD - Patient Relationship Code from file #9002313.19
- +10 ; BPPSNCD - Person Code assigned by payer. 1 - 3 characters free text
- +11 ;
- PROMPTS(BP02,BPDOSDT,BPRELCD,BPPSNCD) ;
- +1 IF '$GET(BP02)
- SET BPQ=-1
- GOTO XPROMPTS
- +2 NEW %,BP300,BPFDA,BPFLD,BPMED,BPMSG,BPQ,DIC,DIR,DIROUT,DTOUT,DUOUT,X,Y,DIRUT
- +3 SET BPQ=""
- +4 ;
- +5 ;Pull Information from Claim
- +6 SET BP300=$GET(^BPSC(BP02,300))
- +7 SET BPRELCD=$TRANSLATE($EXTRACT($PIECE(BP300,U,6),3,99)," ")
- +8 SET BPPSNCD=$TRANSLATE($EXTRACT($PIECE(BP300,U,3),3,99)," ")
- +9 SET BPDOSDT=$$DOSDATE^BPSSCRRS(BPRXIEN,BPRXR)
- +10 ;
- +11 ;Effective Date
- +12 SET DIR(0)="DO"
- SET DIR("A")="Effective Date"
- +13 KILL DIR("?")
- SET DIR("?")="Enter the effective date for the Eligibility Verification transaction"
- +14 SET DIR("B")=$$FMTE^XLFDT(BPDOSDT,"5ZD")
- +15 DO ^DIR
- +16 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET BPQ=-1
- GOTO XPROMPTS
- +17 SET BPDOSDT=Y
- +18 ;
- +19 ;Relationship Code
- +20 NEW X,DIC,Y
- +21 SET DIC("B")=BPRELCD
- +22 SET DIC(0)="QEAM"
- SET DIC=9002313.19
- SET DIC("A")="Relationship Code: "
- +23 DO ^DIC
- +24 ;Check for "^" or timeout
- +25 IF ($DATA(DUOUT))!($DATA(DTOUT))
- SET BPQ=-1
- KILL X,DIC,Y
- GOTO XPROMPTS
- +26 SET BPRELCD=$PIECE(Y,U,2)
- +27 KILL X,DIC,Y
- +28 ;
- +29 ;Person Code
- +30 KILL DIR("?")
- SET DIR(0)="FO^1:3"
- SET DIR("A")="Person Code"
- SET DIR("?")="Enter the Specific Person Code Assigned to the Patient by the Payer"
- +31 SET DIR("B")=BPPSNCD
- +32 DO ^DIR
- +33 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET BPQ=-1
- GOTO XPROMPTS
- +34 SET BPPSNCD=Y
- +35 ;
- +36 ;Ask to proceed
- +37 WRITE !
- SET BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
- +38 IF BPQ'=1
- SET BPQ=-1
- GOTO XPROMPTS
- +39 ;
- XPROMPTS ;
- +1 QUIT BPQ
- +2 ;
- +3 ;Prompt User for Claim to Resubmit (w/EDITS)
- +4 ;
- +5 ; Input values -> BPROMPT - prompt string
- +6 ; BPERRMES - the message to display when the user tries
- +7 ; to make multi line selection (optional)
- +8 ; Piece
- +9 ;output values -> 1 - 1 = okay, <0 = errors, 0 = quit
- +10 ; 2 - patient ien #2
- +11 ; 3 - insurance ien #36
- +12 ; 4 - ptr to #9002313.59
- +13 ; 5 - 1st line for index(es) in LM "VALM" array
- +14 ; 6 - patient's index
- +15 ; 7 - claim's index
- +16 ;
- ASKLINE(BPROMPT,BPERRMES) ;
- +1 NEW BPRET,BPCNT
- +2 SET BPRET=""
- SET BPCNT=0
- +3 FOR
- SET BPRET=$$SELLINE^BPSSCRU4(BPROMPT,"C",VALMAR,"")
- if BPRET'<0
- QUIT
- Begin DoDot:1
- +4 IF BPCNT<1
- SET BPCNT=BPCNT+1
- WRITE !
- +5 IF '$TEST
- SET BPCNT=0
- DO RE^VALM4
- +6 ; (invalid Patient summary line)"
- IF BPRET=-1
- WRITE "Invalid line number"
- +7 IF BPRET=-8
- WRITE $SELECT($GET(BPERRMES)]"":BPERRMES,1:" Invalid line number")
- +8 ; (invalid RX line)"
- IF BPRET=-4
- WRITE "Invalid line number"
- +9 IF BPRET=-2
- WRITE "Please select Patient's summary line."
- +10 IF BPRET=-3
- WRITE "Please specify RX line."
- +11 ; Corrupted array (",BPRET,")"
- IF ",-1,-8,-4,-2,-3,"'[(","_BPRET_",")
- WRITE "Incorrect format."
- End DoDot:1
- +12 QUIT BPRET